Pascal- porovnanie triediacich algoritmov Select Sort a Merg

ickoo44

Potrebujem pomoct dostal som taketo zadanie a vobec neviem kde mam zacat bol by tu niekto kto by mi s tym vedel pomoct?dakujeem..

Zrealizujte porovnanie triediacich algoritmov Select Sort a Merge Sort. Algoritmy porovnajte na triedení číselného poľa. Prvky poľa budú náhodne generované. Porovnanie vykonajte na minimálne troch rôzne dlhých poliach. Minimálna dĺžka poľa (t.j. počet prvkov) bude 1000 a maximálna 32 000 prvkov.

Pre zisťovanie času, ktorý algoritmus spotrebuje na triedenie môžete použiť procedúru GetTime(var Hour, Minute, Second, Sec100: word);

Procedúru treba volať pred začiatkom triedenia a potom po triedení. Získate tak dve hodnoty času, ktorých rozdiel je čas potrebný pre triedenie postupnosti čísel.

V rámci zadania definujte vstupné a výstupné premenné a podmienky, ktoré musia spĺňať. Opíšte základný postup riešenia. Vaše riešenie dokladujte zápisom algoritmu (štruktogram alebo vývojový diagram), komentovaným odladeným zdrojovým textom v Pascale.

piton

Ako ze nevies kde mas zacat? Ved urobis si funkciu na merge a druhu na select, najdi si na niekde vzor na webe, vygenerujes pole, zotriedis ho jednym algoritmom, druhym a porovnas casy, ziadna velka veda tam nieje...

Uz to tu bolo asi 3x, hladaj

to boli iné algoritmy (konkrétne ja som tu našiel že má robiť porovnanie merge sortu a quick sortu)

ale podstata je rovnaká, a načrtol ju už piton (vlastne presný postup mal napísaný aj v zadaní, tak asi len čaká kedy mu to sem niekto dá vypracované)

ickoo44

audiotrack napísal:to boli iné algoritmy (konkrétne ja som tu našiel že má robiť porovnanie merge sortu a quick sortu)
ale podstata je rovnaká, a načrtol ju už piton (vlastne presný postup mal napísaný aj v zadaní, tak asi len čaká kedy mu to sem niekto dá vypracované)

no nejde mi o to aby mi to sem niekto dal urobene...ja som chcel vidiet len nieco podobne nech viam ako to mam robit..mozes mi poslat link na to od pitona?dik

klikni na hladat, tam zadaj "Zrealizujte porovnanie triediacich algoritmov" a mas...

piton

link na to od pitona je tu: nech sa paci

http://www.hojko.com/post1159655.html#1159655
Je to fakt uplne jednoduche, zapni mozog a spravis to aj sam...

ickoo44

piton napísal:link na to od pitona je tu: nech sa paci
http://www.hojko.com/post1159655.html#1159655
Je to fakt uplne jednoduche, zapni mozog a spravis to aj sam...

si mi poslal link na tuto straku:D no nevadi

//autoeditácia príspevku ( 30 Apr 2009, 20:51 )
dal som to do vyhladavaca a naslo mi 540 odkazov a uz som bol dost daleko a nenasiel som to tam tak pls poslite mi link na tu strenkuu

piton

Dal som ti link na to co myslel audiotrack

ickoo44

piton napísal:Dal som ti link na to co myslel audiotrack

ale ved kliknem na ten lin co si mi dal tak ma to da na toto iste (moje zadanie) a nie na to od audiotracka

môj bože, ser už na to. Tu máš tú tému, aj tak tam ale nie je odpoveď. Ja som iba písal že tu bola podobná téma ale chcel tam iné triediacie algoritmy:
http://www.hojko.com/max-sort-a-merge-sort-t117770.html
http://www.hojko.com/max-sort-a-shell-sort-t94258.html

ickoo44

no uz som zohnal ten podobny program ale neviem prispôsobit do toho zapis toho merge sortu mozete mi s tym niekto pomoct? dakujem

program select_vs_bubble;
uses crt,dos;

const n=8000;
alg1='SelectSort';
alg2='BubbleSort';

type policko=array [1 .. n] of integer;
PPole=^policko;

var i:integer;
time,time1,time2:real;
MicroTime:word;
a1,a2:PPole;

procedure generuj_pole(var a1,a2:PPole);
begin
randomize;
for i:=1 to n do a1^:=random(1000);
for i:=1 to n do a2^:=a1^;
end;

procedure StartTimer;
var h,m,s:word;

begin
GetTime(h,m,s,MicroTime);
Time:=h*3600+m*60+s;
end;

function StopTimer:real;
var h,m,s,micro:word;
begin
GetTime(h,m,s,micro);
StopTimer:=(h*3600+m*60+s)-Time+(integer(micro)-integer(MicroTime))/1000;
end;

procedure SelectSort(max: integer; a:PPole); { 'max' je pocet prvkov pola, 'a' je ukazatel na nejake pole }
var i, j, min, pom : integer;
begin
for i := 1 to max - 1 do
begin
min := a^;
for j := i + 1 to max do
begin
if min > a^[j] then
begin
min := a^[j];
pom := j;
end;
end;
a^[pom] := a^;
a^ := min;
end;
end;

procedure BubbleSort(a:PPole; maximum: integer);
var k, l, pom : integer;

begin
for k := 1 to maximum do
begin
for l := 1 to maximum-1 do
begin
if (a^[l] > a^[l+1]) then
begin
pom := a^[l];
a^[l] := a^[l+1];
a^[l+1] := pom;
end;
end;
end;
end;

{ main }
begin
clrscr;

{ vytvori 2 polia v halde }
new(a1);
new(a2);

{ vygeneruje nahodne prvky do pola 1 a toto pole potom skopiruje do pola 2 }
generuj_pole(a1,a2);

{ SelectSort }
StartTimer;
SelectSort(n,a1);
time1:=StopTimer;

{ BubbleSort }
StartTimer;
BubbleSort(a2,n);
time2:=StopTimer;

{ vypis vysledky }
writeln(alg1,' utriedil ',n,' prvkove pole za ',time1:0:5,' sek.');
writeln(alg2,' utriedil ',n,' prvkove pole za ',time2:0:5,' sek.');

{ vrati pamat }
dispose(a1);
dispose(a2);

readkey;
end.

merge sort máš tu: http://www.hojko.com/pascal-triedenie-t118391.html (merge je tam ako samostatná procedúra, takže by si nemal mať problém to napasovať kdekolvek)

ickoo44

no mam to ale neviem tieto znaky( ^ ) ako mam dat lebo ja tento semester programko nemam a neviem co to znamena viem ze len nieco na zvecsenie pamate a bez toho asi nepojde...

//autoeditácia príspevku ( 10 May 2009, 22:15 )
prosim nemoze ten program co som dal hore niekto dorobit tak aby to fungovalo?uz sa s tym trapim tyzden a nerozumiem tomu co tam mam zle a utorok to musim odovzdat tak pls pomoze dakujem

ak nevieš pracovať so smerníkmi, tak odstráň riadky:

Kód: Vybrať všetko

type policko=array [1 .. n] of integer;
PPole=^policko;

a riadok

Kód: Vybrať všetko

a1,a2:PPole;

napíš ako

Kód: Vybrať všetko

a1,a2:array [1 .. n] of integer;

Potom môžeš všetky ukazovatele z tvaru a^[l] prepísať na klasické polia ako a[l]. Neviem ale či ti dovolí použiť n=8000, zrejme iba maximálne 5000

ickoo44

Kód: Vybrať všetko

program selectsort;
  uses crt,DOS;
  const n = 32000;

type pole=array[1..n] of integer;
     var i :integer;
         a :pole;
         Time:real;
         MicroTime:word;
         Time1,
         Time2:real;

  {spustenie casovacu}
procedure StartTimer;
   var h,m,s:word;
       begin
         GetTime(h,m,s,MicroTime);
         Time:=h*3600+m*60+s;
       end;


  {vratenie hodnoty casu, ktory uplynul od posledneho startimer}
function StopTimer:real;
   var h,m,s,micro:word;
       begin
         GetTime(h,m,s,micro);
         StopTimer:=(h*3600+m*60+s)-Time+(integer(micro)-integer(MicroTime))/1000;
       end;


{-------procedura triedenia--------}
procedure select(n:integer;var a:pole);
var i, j,min,minI : integer;
begin
  StartTimer;
  for i := 1 to n do
  begin
    minI := i;
    min := a[i];
    j := i + 1;
    while j < n do
    begin
      if a[j] < min
      then begin
        minI := j;
        min := a[j];
        end;
      j:=j+1;
    end;
    a[minI] := a[i];
    a[i] := min;
  end;
end;


procedure MergeSort(b:integer, a:Pole);
var i, j, k,p,q,r: integer;

begin { Merge }
i := p;
j := q + 1;
k := p;
while ((i <= q) and (j <= r)) do
begin
if (a[i] < a[j])
then begin
B[k] := A^[i];
i := i + 1;
end
else begin
B[k] := a[j];
j := j + 1;
end;
k := k + 1;
end;
while (i <= q) do
begin
B[k] := a[i];
k := k + 1;
i := i + 1;
end;
while (j <= r) do
begin
B[k] := a[j];
k := k + 1;
j := j + 1;
end;
for k := p to r do a[k] := B[k];
end; 
  end;
end;



{--------hlavny program---------}
begin

clrscr;
    randomize;
    for i:=1 to 1000 do
    begin
      a[i]:=random(1000);
      {writeln(i,': ',a[i]:4);}
    end;
    MergeSort(1000,a) ;
    {writeln('MergeSorted:');
    for i:=1 to n do writeln(i,': ',a[i]:4);}
    Time2:=StopTimer; {zastavi casovac a ulozi a cas}
    for i:=1 to 1000 do
    begin
      a[i]:=random(1000);
      {writeln(i,': ',a[i]:4);}
    end;
    select(1000,a);
    {writeln('SelectSorted:');
    for i:=1 to n do writeln(i,': ',a[i]:4);}
    Time1:=StopTimer; {zastavi casovac a ulozi cas}

    Writeln('Cas selectSort(1000): ',Time1:6:3);
    Writeln('Cas MergeSort(1000): ',Time2:6:3);

        randomize;
    for i:=1 to 20000 do
    begin
      a[i]:=random(1000);
      {writeln(i,': ',a[i]:4);}
    end;
    MergeSort(20000,a) ;
    {writeln('MergeSorted:');
    for i:=1 to n do writeln(i,': ',a[i]:4);}
    Time2:=StopTimer; {zastavi casovac a ulozi a cas}
    for i:=1 to 20000 do
    begin
      a[i]:=random(1000);
      {writeln(i,': ',a[i]:4);}
    end;
    select(20000,a);
    {writeln('SelectSorted:');
    for i:=1 to n do writeln(i,': ',a[i]:4);}
    Time1:=StopTimer; {zastavi casovac a ulozi cas}

    Writeln('Cas selectSort(20000): ',Time1:6:3);
    Writeln('Cas MergeSort(20000): ',Time2:6:3);



        randomize;
    for i:=1 to 32000 do
    begin
      a[i]:=random(1000);
      {writeln(i,': ',a[i]:4);}
    end;
    MergeSort(32000,a) ;
    {writeln('MergeSorted:');
    for i:=1 to n do writeln(i,': ',a[i]:4);}
    Time2:=StopTimer; {zastavi casovac a ulozi a cas}
    for i:=1 to 32000 do
    begin
      a[i]:=random(1000);
      {writeln(i,': ',a[i]:4);}
    end;
    select(32000,a);
    {writeln('SelectSorted:');
    for i:=1 to n do writeln(i,': ',a[i]:4);}
    Time1:=StopTimer; {zastavi casovac a ulozi cas}

    Writeln('Cas selectSort(32000): ',Time1:6:3);
    Writeln('Cas MergeSort(32000): ',Time2:6:3);


      readkey;
end.

Alebo toto.Nerozumiem tomu co znamena v Merge sorte to B lebo to som nasiel niekde na nete a neviem to dat do kopy...

tak pls pomozte niekto

ten merge sort je dosť divný.. Malo by to byť asi nejak takto:

Kód: Vybrať všetko

procedure Merge (var A: pole; p, q, r: integer);
var i, j, k: integer;
var B: pole;
begin
  i := p;
  j := q + 1;
  k := p;
  while ((i <= q) and (j <= r)) do
    begin
    if (A[i] < A[j]) then begin
      B[k] := A[i];
      i := i + 1;
    end else begin
      B[k] := A[j];
      j := j + 1;
      end;
    k := k + 1;
    end;
  while (i <= q) do begin
    B[k] := A[i];
    k := k + 1;
    i := i + 1;
  end;
  while (j <= r) do begin
    B[k] := A[j];
    k := k + 1;
    j := j + 1;
  end;
  for k := p to r do A[k] := B[k];
end;

procedure MergeSort (var A: pole; p, r: integer);
var q: integer;
begin 
  if (p < r) then
    begin
      q := (p + r) div 2;
      MergeSort (A, p, q);
      MergeSort (A, q + 1, r);
      Merge (A, p, q, r);
    end;
end;

a použitie v tvojom programe:

Kód: Vybrať všetko

MergeSort(a, 1, 1000);

Máš tam ale omnoho viac chýb a nelogických vecí ako iba tento merge

ickoo44

Kód: Vybrať všetko

program triedenie;
uses crt,dos;
const n=6000;

type pole = array[1..N] of integer;
var A,B : pole;
    h,m,s,ss,h1,m1,s1: word;
    time: longint;
    microtime:word;
    time1,time2: real;

  procedure startTime;
  var h, m, s : word;
  begin
    GetTime(h,m,s,MicroTime);
    Time := h * 3600 + m * 60 + s;
  end;

function StopTime: real;

  var h, m, s, micro : word;
  begin
    GetTime(h, m, s, micro);
    stoptime := h * 3600 + m * 60 + s - Time + (integer(micro) -integer(microtime)) / 1000;
  end;


procedure vytvor_pole;  {Vytvori nahodny vektor N cisiel}
  var i : integer;
  begin
    Randomize;
    for i := 1 to N do A[i] := Random(4000);
    for i := 1 to N do B[i] := A[i];
  end;



procedure Select ;
var i, j, min,max, pom : integer;
begin
  for i := 1 to max - 1 do
  begin
    min := a[i];
    for j := i + 1 to max do
    begin
      if min > a[j] then
      begin
        min := a[j];
        pom := j;
      end;
    end;
    a[pom] := a[i];
    a[i] := min;
  end;
end;

procedure Merge;
var i, j, k,p,q,r: integer;
var B: pole;
begin { Merge }
i := p;
j := q + 1;
k := p;
while ((i <= q) and (j <= r)) do
begin
if (A[i] < A[j])
then begin
B[k] := A[i];
i := i + 1;
end
else begin
B[k] := A[j];
j := j + 1;
end;
k := k + 1;
end;
while (i <= q) do
begin
B[k] := A[i];
k := k + 1;
i := i + 1;
end;
while (j <= r) do
begin
B[k] := A[j];
k := k + 1;
j := j + 1;
end;
for k := p to r do A[k] := B[k];
end;


begin
clrscr;
vytvor_pole;
starttime;
Select;
delay(80);
Time1:=stoptime;
writeln ('cas SelectSort je ' ,time1:6:3,' sekund');
starttime;
merge;
delay(80);
time2:=stoptime;
writeln ('cas merge sortu je ' , time2:6:3,' sekund');

readln;
end.

tento program funguje uz a musel som tam dat delay(80) aby cas merge sortu nebol 0.Ale ide to len do 7000 prvkov pola ked dam viac napise mi error 202: Stack overflow error uz to tu jeden riesil ale nedoriesil a potom som tu cital ze tam mam dat ems alebo xms ale to mi nefunguje pascal to nemoze najst tak co mi poradite?

čo ti poradím? dve veci:
1) dávaj už konečne kod do code a nie do citácie, už ma to po tebe nebaví upravovať
2) kašli na ems a xms, pri tvojích "zručnostiach" to nezvládneš keď si týždeň prerábal hotové jednoduché riešenie

ickoo44

no dobre chcel by som vidiet teba ako by si to robil keby si pred tym nemal pascal...