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

klaudia · Napísal **klaudia**: 04.05.2010 18:25 | Zlé triedenie...prosím pomôžte!!

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 | Zlé triedenie...prosím pomôžte!!

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

klaudia

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 | Zlé triedenie...prosím pomôžte!!

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

alee..

neches mi poslat tie vsetky srandy z toho cd?

m@-nX · Napísal **m@-nX**: 04.05.2010 19:32 | Zlé triedenie...prosím pomôžte!!

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

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 | Zlé triedenie...prosím pomôžte!!

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

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

stopa27 · Napísal **stopa27**: 04.05.2010 20:10 | Zlé triedenie...prosím pomôžte!!

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

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 | Zlé triedenie...prosím pomôžte!!

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

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

klaudia

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 | Zlé triedenie...prosím pomôžte!!

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 | Zlé triedenie...prosím pomôžte!!

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

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 | Zlé triedenie...prosím pomôžte!!

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

klaudia

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 | Zlé triedenie...prosím pomôžte!!

ja som vravel o shellsorte

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

klaudia

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 | Zlé triedenie...prosím pomôžte!!

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

jaj 3x edit

uz to ide

ak niekto bude potrebovat tak napiste SS

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

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

Podobné témy

Zlé zobrazovanie

zle rozbalovanie

Zle znacenie

Zle kodovanie?

Zle fotky

Zlé ramky

zle zobrazovanie

Zle spojenie

zle cidlo?

zlé ukladanie titulkov

zle som nastavil ???

Zlé zobrazovanie stránok

zle usadeny chladič ?

Zle nalepený display

CPU zle chladene ?

zle nainštalovaný GRUB