Na podstawie pseudokodu Cormena (Algorithms unklocked , Introduction to algorithms) napisałem kody sortowania
W sortowaniu przez scalanie Cormen używa wartowników oraz dwóch tablic pomocniczych
Udało mi się usunąć wartowników i jedną z tablic pomocniczych
jednak została mi rekurencja
program sort; uses crt; const maxT=2500; type tablica=array[1..maxT]of real; procedure merge(var A:tablica;p,q,r:integer); var n1,n2,i,j,k:integer; B:tablica; begin n1:=q-p+1; n2:=r-q; for i:=p to r do B[i-p+1]:=A[i]; i:=1; j:=n1+1; k:=p; while((i<=n1)and(j<=n1+n2)) do begin if(B[i]<=B[j]) then begin A[k]:=B[i]; i:=i+1; end else begin A[k]:=B[j]; j:=j+1; end; k:=k+1; end; while(i<=n1) do begin A[k]:=B[i]; i:=i+1; k:=k+1; end; while(j<=n1+n2) do begin A[k]:=B[j]; j:=j+1; k:=k+1; end; end; procedure mergesort(var A:tablica;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; var k,n,p,q:integer; A:tablica; esc:char; begin clrscr; repeat writeln('Podaj rozmiar tablicy'); readln(n); randomize; for k:=1 to n do begin p:=(1-2*random(2))*random(10); q:=1+random(10); A[k]:=(p/q); end; for k:=1 to n do write(A[k]:1:10,' '); writeln; writeln; mergesort(A,1,n); for k:=1 to n do write(A[k]:1:10,' '); writeln; writeln; esc:=readkey; until esc=#27; end.
program sort; uses crt; const maxT=2500; type tablica=array[1..maxT]of real; procedure heapify(var A:tablica;i,heapsize:integer); var l,r,largest:integer; temp:real; begin l:=2*i; r:=2*i+1; if((l<=heapsize)and(A[l]>A[i])) then largest:=l else largest:=i; if((r<=heapsize)and(A[r]>A[largest])) then largest:=r; if(largest<>i) then begin temp:=A[i]; A[i]:=A[largest]; A[largest]:=temp; heapify(A,largest,heapsize); end; end; procedure buildheap(var A:tablica;len:integer); var i:integer; begin for i:=len div 2 downto 1 do heapify(A,i,len); end; procedure heapsort(var A:tablica;len:integer); var i,heapsize:integer; temp:real; begin buildheap(A,len); heapsize:=len; for i:=len downto 2 do begin temp:=A[1]; A[1]:=A[i]; A[i]:=temp; heapsize:=heapsize-1; heapify(A,1,heapsize); end; end; var k,n,p,q:integer; A:tablica; esc:char; begin clrscr; repeat writeln('Podaj rozmiar tablicy'); readln(n); randomize; for k:=1 to n do begin p:=(1-2*random(2))*random(10); q:=1+random(10); A[k]:=(p/q); end; for k:=1 to n do write(A[k]:1:10,' '); writeln; writeln; heapsort(A,n); for k:=1 to n do write(A[k]:1:10,' '); writeln; writeln; esc:=readkey; until esc=#27; end.
QuickSort z przykładów Borland Pascala
uses crt; const maxT=2500; type tablica=array[1..maxT]of real; procedure quickSort(var A:tablica;l,r:integer); var i,j:integer; x,y:real; begin i:=l; j:=r; x:=A[(l+r)div 2]; repeat while(A[i]<x) do i:=i+1; while(x<A[j]) do j:=j-1; if(i<=j) then begin y:=a[i]; a[i]:=a[j]; a[j]:=y; i:=i+1; j:=j-1; end; until(i>j); if(l<j) then quickSort(A,l,j); if(i<r) then quickSort(A,i,r); end; var k,n,p,q:integer; A:tablica; esc:char; begin clrscr; repeat writeln('Podaj rozmiar tablicy'); readln(n); randomize; for k:=1 to n do begin p:=(1-2*random(2))*random(10); q:=1+random(10); A[k]:=(p/q); end; for k:=1 to n do write(A[k]:1:10,' '); writeln; writeln; quickSort(A,1,n); for k:=1 to n do write(A[k]:1:10,' '); writeln; writeln; esc:=readkey; until esc=#27; end.
Użytkownik Mariusz M edytował ten post 11.03.2017 - 15:00