Zlé triedenie...prosím pomôžte!!

klaudia · Napísal **klaudia**: 04.05.2010 18:25

Ahojte. Prosím Vás mohli by ste sa na to mrknúť? Zajtra to potrebujem odovzdať a nejak zle mi to triedi..

Kód:

program shellsortAselectsort;
uses crt,dos;

procedure ShellSort (var c: array of integer; n,h : integer);
var aux,i : integer;
begin
  if h > 0 then begin
  if n > h then begin
     ShellSort(c,n - h,h);
if c[n] < c[n - h] then begin
aux:= c[n];
i:= n;
repeat
 c[i] := c[i - h];
 i := i - h;
until (i = h) or (aux > c[i - h]);
 c[i] := aux;
end;
end;
ShellSort(c,n,h div 3);
end;
end;

procedure SelectSort (var c1: array of integer; p: integer);
var i,j,min,tmp: integer;
begin
for i:=0 to (p - 1) do
        begin
        min:=i;
        for j:=(i+1) to (p - 1) do
                begin
                if (c1[j] < c1[min]) then min:=j;
                end;
        tmp:=c1[i];
        c1[i]:=c1[min];
        c1[min]:=tmp;
        end;
end;




var pole1: array [0..5000] of integer;
    pole2: array [0..10000] of integer;
    pole3: array [0..15000] of integer;
    p    : array [0..50] of integer;
    i    : integer;
    h,m,s,ss,hod,min,sek,s100: word;

begin
clrscr;
writeln('Klaudia Martvonova');
writeln('zadanie c.5');
writeln;
randomize;
textcolor(4);
writeln ('SELECTSORT');

for i:= 0 to 5000 do pole1[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole1,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

for i:= 0 to 10000 do pole2[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole2,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

for i:= 0 to 15000 do pole3[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole3,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

textcolor(15);
writeln;
writeln('SHELLSORT');
gettime(h,m,s,ss);
ShellSort(pole1,5000,1);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);
gettime(h,m,s,ss);
ShellSort(pole2,10000,1);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);
gettime(h,m,s,ss);
ShellSort(pole3,15000,1);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

textcolor(2);
writeln;
writeln('SELECTSORT');
textcolor(9);
for i:=1 to 20 do begin
        p[i]:=random(20);
        write(p[i], ' ');
end;
writeln;
writeln;
textcolor(8);
writeln('TRIEDENIE PRVKOV');
textcolor(5);
SelectSort(p, 20);
for i:=1 to 20 do begin
        write(p[i], ' ');
end;

textcolor(2);
writeln;
writeln;
writeln('SHELLSORT');
textcolor(9);
for i:=1 to 20 do begin
        p[i]:=random(20);
        write(p[i], ' ');
end;
writeln;
textcolor(8);
writeln;
writeln('TRIEDENIE PRVKOV');
textcolor(5);
ShellSort(p, 20, 20);
for i:=1 to 20 do begin
        write(p[i], ' ');
end;

readln;
end.

ac.milan · Napísal **ac.milan**: 04.05.2010 18:36

upravene,link treba dat do code...a co znamena,ze ti to zle triedi?

klaudia · Napísal autor témy **klaudia**: 04.05.2010 18:54

rozmyslala som ci code alebo quote..sorry
no tam ma to zoradit od najmensieho po najvacsi nie? a select sort roztriedi..ale niekedy posledne cislo je mensie..obcas sa stane..
no a shell sort ten to neviem akym systemom triedi ale uplne na :shit:

vobec nie tak ako by mal..

ac.milan · Napísal **ac.milan**: 04.05.2010 19:01

moment,vyhrabem stare CD z UCM s mojimi ulohami,ako som to mal ja a kuknem to...
ak to teda najdem a mal som aj ja tie iste sorty ako ty

klaudia · Napísal autor témy **klaudia**: 04.05.2010 19:03

alee..

neches mi poslat tie vsetky srandy z toho cd?

m@-nX · Napísal **m@-nX**: 04.05.2010 19:32

http://www.upnito.sk/subor/f8af1edfedbed6cd267337dfa3f8c1cf.html

Skus stiahnut tento flash mozno ti nieco pomoze. SelectSort je to "trideni primym vyberem" a ShellSort je tam normalne. Otvor to klasicky v prehliadaci ak ti to nepojde samostatne

klaudia · Napísal autor témy **klaudia**: 04.05.2010 19:48

tak to je pekne co si poslal

dik..len ja by som chcela vediet co je zle na tom mojom... : /

ac.milan · Napísal **ac.milan**: 04.05.2010 19:53

klaudia píše:

alee..

neches mi poslat tie vsetky srandy z toho cd?

to by nebolo odomna pekne,nemyslis? aj ked to myslis pekne

budem ta kontaktovat,no neviem ci budem mat uspech, nasiel som iba bubble sort a quick,no pohladam dalej...

klaudia · Napísal autor témy **klaudia**: 04.05.2010 19:57

cakam cakam ... a to moje sa neda opravit? :side:

stopa27 · Napísal **stopa27**: 04.05.2010 20:10

http://www.gymrk.iglu.cz/DSA-vyhladavanie_usporaduvanie_2009x.pdf
tuto je nasa prednaska z datovych struktur a algoritmov, urcite si tam vyberies ten spravny sort - uz ho staci len prepisat do pozadovaneho jazyka

klaudia · Napísal autor témy **klaudia**: 04.05.2010 20:22

stopa27 píše:

http://www.gymrk.iglu.cz/DSA-vyhladavanie_usporaduvanie_2009x.pdf
tuto je nasa prednaska z datovych struktur a algoritmov, urcite si tam vyberies ten spravny sort - uz ho staci len prepisat do pozadovaneho jazyka

dakujem..mozem sa opytat i,j,h,v,N : integer -> tieto premenne mam ako komentovat?

stopa27 · Napísal **stopa27**: 04.05.2010 20:26

no i,j su cyklove premenne, N je dlzka pola a h,v su premenne pouzite pri vypoctoch

ale to sa bezne ani nekomentuje
//inac ak ti nebude fungovat kod z tych prednasok, nehladaj prilis dlho chybu u seba, prednasky z DSA boli plne chyb, len uz nepametam ako na tom bola tato

klaudia · Napísal autor témy **klaudia**: 04.05.2010 20:28

dik...skusim to ale stale nik nevidi chybu v hentom mojom prvom? :roll:

klaudia · Napísal autor témy **klaudia**: 04.05.2010 21:47

no tak skompiluje, vyhodi 2casy select sortu a koniec..wtf?!

Kód:

program shellsortAselectsort;
uses crt,dos;

procedure ShellSort(var pol: array of integer; c:integer);
var i,j,h,v,N : integer;
begin
N:= length(pol);
h:= 1;
repeat
        h:=(3*h)+1;
until h > N;

repeat
        h:=(h div 3);
        for i:= (h+1) to N do begin
                v:=pol[i];
                j:=i;
                while ( (j > h) and ( pol[j-h] > v) ) do begin
                        pol[j]:= pol[j - h];
                        dec(j, h);
                end;
                pol[j]:=v;
        end;
until h = 1;
end;


{begin
  if h > 0 then begin
  if n > h then begin
     ShellSort(c,n - h,h);
if c[n] < c[n - h] then begin
aux:= c[n];
i:= n;
repeat
 c[i] := c[i - h];
 i := i - h;
until (i = h) or (aux > c[i - h]);
 c[i] := aux;
end;
end;
ShellSort(c,n,h div 3);
end;
end;}


procedure SelectSort (var pole: array of integer; p: integer);
var i,j,min,tmp: integer;
begin
for i:=0 to (p - 1) do
        begin
        min:=i;
        for j:=(i+1) to (p - 1) do
                begin
                if (pole[j] < pole[min]) then min:=j;
                end;
        tmp:=pole[i];
        pole[i]:=pole[min];
        pole[min]:=tmp;
        end;
end;




var pole1: array [0..5000] of integer;
    pole2: array [0..10000] of integer;
    pole3: array [0..15000] of integer;
    p    : array [0..50] of integer;
    i    : integer;
    h,m,s,ss,hod,min,sek,s100: word;

begin
clrscr;
writeln('Klaudia Martvonova');
writeln('zadanie c.5');
writeln;
randomize;
textcolor(4);
writeln ('SELECTSORT');

for i:= 0 to 5000 do pole1[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole1,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

for i:= 0 to 10000 do pole2[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole2,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

for i:= 0 to 15000 do pole3[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole3,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

textcolor(15);
writeln;
writeln('SHELLSORT');
gettime(h,m,s,ss);
ShellSort(pole1,5000);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);
gettime(h,m,s,ss);
ShellSort(pole2,10000);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);
gettime(h,m,s,ss);
ShellSort(pole3,15000);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

textcolor(2);
writeln;
writeln('SELECTSORT');
textcolor(9);
for i:=1 to 20 do begin
        p[i]:=random(20);
        write(p[i], ' ');
end;
writeln;
writeln;
textcolor(8);
writeln('TRIEDENIE PRVKOV');
textcolor(5);
SelectSort(p, 20);
for i:=1 to 20 do begin
        write(p[i], ' ');
end;

textcolor(2);
writeln;
writeln;
writeln('SHELLSORT');
textcolor(9);
for i:=1 to 20 do begin
        p[i]:=random(20);
        write(p[i], ' ');
end;
writeln;
textcolor(8);
writeln;
writeln('TRIEDENIE PRVKOV');
textcolor(5);
ShellSort(p, 20);
for i:=1 to 20 do begin
        write(p[i], ' ');
end;

readln;
end.

stopa27 · Napísal **stopa27**: 04.05.2010 21:56

exit code 201 znamena chyba rozsahu pola, niekde asi citas/pises za hranice.
//v selectsorte to bude asi, mas tam index od 0, pascal ide myslim od 1

m@-nX · Napísal **m@-nX**: 04.05.2010 21:58

len tak na rychlo, je to upravene podla toho fleshu, skus to takto, co to spravi

Kód:

procedure SelectSort (var c1: array of integer; p: integer);
var i,j,min,tmp: integer;
begin
for i:=0 to (p - 1) do
        begin
        min:=i;
        for j:=(i+1) to (p - 1) do
                begin
                if (c1[j] < c1[min]) then min:=j;
                end;
        tmp:=c1[min];
        c1[min]:=c1[i];
        c1[i]:=tmp;
        end;
end; 

klaudia · Napísal autor témy **klaudia**: 04.05.2010 22:01

select sort ide v pohode az kym tam neupravim ten shell sort..to nechapem ...lebo ta prva verzia co je uplne hore tak ide aj to aj to .. len v tom shell sorte nieco blbne a nejak zle to triedi... *** :cry:

stopa27 · Napísal **stopa27**: 04.05.2010 22:09

chyba rozsahu
length(pole) vratilo 5001 namiesto 20.
skus nahradit N:=length(); za N:=c;

klaudia · Napísal autor témy **klaudia**: 04.05.2010 22:12

m@-nX píše:

len tak na rychlo, je to upravene podla toho fleshu, skus to takto, co to spravi

Kód:

procedure SelectSort (var c1: array of integer; p: integer);
var i,j,min,tmp: integer;
begin
for i:=0 to (p - 1) do
        begin
        min:=i;
        for j:=(i+1) to (p - 1) do
                begin
                if (c1[j] < c1[min]) then min:=j;
                end;
        tmp:=c1[min];
        c1[min]:=c1[i];
        c1[i]:=tmp;
        end;
end; 

DAKUJEM ZA SNAHU..ale..ShellSort potrebujem tam dorobit..

stopa27 · Napísal **stopa27**: 04.05.2010 22:13

ja som vravel o shellsorte

ked to nahradit v tom kode z pdf za to, co som ti napisal, tak to pekne funguje

klaudia · Napísal autor témy **klaudia**: 04.05.2010 22:17

stopa27 píše:

ja som vravel o shellsorte

ked to nahradit v tom kode z pdf za to, co som ti napisal, tak to pekne funguje

no ja som to prepisala a nejde mi to..teda prepisala som len tu proceduru..sak aj som to tu hodila..cely ten zdrojovy kod :roll:

stopa27 · Napísal **stopa27**: 04.05.2010 22:18

toto mi funguje (az na drobnost, ze v select sotre sa neberie do uvahy posledny prvok pri triedeni

)

Kód:

program shellsortAselectsort;
uses crt,dos;

procedure ShellSort(var pol: array of integer; c:integer);
var i,j,h,v,N : integer;
begin
N:= c;
h:= 1;
repeat
        h:=(3*h)+1;
until h > N;

repeat
        h:=(h div 3);
        for i:= (h+1) to N do begin
                v:=pol[i];
                j:=i;
                while ( (j > h) and ( pol[j-h] > v) ) do begin
                        pol[j]:= pol[j - h];
                        dec(j, h);
                end;
                pol[j]:=v;
        end;
until h = 1;
end;


{begin
  if h > 0 then begin
  if n > h then begin
     ShellSort(c,n - h,h);
if c[n] < c[n - h] then begin
aux:= c[n];
i:= n;
repeat
 c[i] := c[i - h];
 i := i - h;
until (i = h) or (aux > c[i - h]);
 c[i] := aux;
end;
end;
ShellSort(c,n,h div 3);
end;
end;}


procedure SelectSort (var pole: array of integer; p: integer);
var i,j,min,tmp: integer;
begin
for i:=0 to (p - 1) do
        begin
        min:=i;
        for j:=(i+1) to (p - 1) do
                begin
                if (pole[j] < pole[min]) then min:=j;
                end;
        tmp:=pole[i];
        pole[i]:=pole[min];
        pole[min]:=tmp;
        end;
end;




var pole1: array [0..5000] of integer;
    pole2: array [0..10000] of integer;
    pole3: array [0..15000] of integer;
    p    : array [0..50] of integer;
    i    : integer;
    h,m,s,ss,hod,min,sek,s100: word;

begin
clrscr;
writeln('Klaudia Martvonova');
writeln('zadanie c.5');
writeln;
randomize;
textcolor(4);
writeln ('SELECTSORT');

for i:= 0 to 5000 do pole1[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole1,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

for i:= 0 to 10000 do pole2[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole2,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

for i:= 0 to 15000 do pole3[i]:=random(15000);
gettime(h,m,s,ss);
SelectSort(pole3,i);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

textcolor(15);
writeln;
writeln('SHELLSORT');
gettime(h,m,s,ss);
ShellSort(pole1,5000);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);
gettime(h,m,s,ss);
ShellSort(pole2,10000);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);
gettime(h,m,s,ss);
ShellSort(pole3,15000);
gettime(hod,min,sek,s100);
 if s100>ss then writeln(hod-h,':',min-m,':',sek-s,':',s100-ss)
  else writeln(hod-h,':',min-m,':',sek-s,':',s100);

textcolor(2);
writeln;
writeln('SELECTSORT');
textcolor(9);
for i:=1 to 20 do begin
        p[i]:=random(20);
        write(p[i], ' ');
end;
writeln;
writeln;
textcolor(8);
writeln('TRIEDENIE PRVKOV');
textcolor(5);
SelectSort(p, 20);
for i:=1 to 20 do begin
        write(p[i], ' ');
end;

textcolor(2);
writeln;
writeln;
writeln('SHELLSORT');
textcolor(9);
for i:=1 to 20 do begin
        p[i]:=random(20);
        write(p[i], ' ');
end;
writeln;
textcolor(8);
writeln;
writeln('TRIEDENIE PRVKOV');
textcolor(5);
ShellSort(p, 20);
for i:=1 to 20 do begin
        write(p[i], ' ');
end;

readln;
end.

klaudia · Napísal autor témy **klaudia**: 04.05.2010 22:21

jaj 3x edit

uz to ide

ak niekto bude potrebovat tak napiste SS

Zlé triedenie...prosím pomôžte!!

Podobné témy