INFOPedia : PRGSWcode

HomePage :: Categorie :: Indice :: Ultime modifiche :: Ultimi commenti :: Login/Registrazione
Questo è un piccolo programmino che racchiude i principali algoritmi di ordinamento.
da sottolineare che i parametri delle varie procedure sarebbero dovuti essere passati per indirizzo, e non per valore come ho fatto io, ma ciò mi è servito per ordinare una copia del vettore, piuttosto che quella "originale", per poter applicare in successione i vari algoritmi senza dover ricreare i vattore disordinato.

program Ordinamenti;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Const
  n=25;
Type
  VettInteger=Array[1..n]of integer;
//-------------------------------------------
Procedure Print(v:VettInteger);
var
 i:integer;
Begin
For i:=1 to n do
 Write(V[i]:2,' ');
End;
//-------------------------------------------
Procedure Genera(Var V:VettInteger);
var
 i:Integer;
Begin
For i:=1 to n do
 V[i]:=(random(100)+1);
end;
//-------------------------------------------
Procedure Scambia(var x,y:Integer);
var
 z:integer;
Begin
 z:=y;
 y:=x;
 x:=z;
End;
//-------------------------------------------
Procedure SelectionSort(V:Vettinteger);
var
i,j:Integer;
Begin
Writeln('Ordinamento ingenuo');
For j:=1 to n-1 do
 begin
 For i:=j+1 to n do
  if V[j]>V[i] then Scambia(V[i],V[j]);
 end;
Print(V);
writeln;
writeln;
End;
//-------------------------------------------
Procedure BubbleSort1(v:VettInteger);
Var
i,j:integer;
Begin
Writeln('Primo Ordinamento Bubblesort');
For j:=1 to n-1 do
 For i:=1 to n-1 do
  If V[i]>V[i+1] then Scambia(V[i],V[i+1]);
Print(v);
Writeln;
Writeln;
End;
//-------------------------------------------
//-------------------------------------------
Procedure BubbleSort2(v:VettInteger);
Var
i,j,m:integer;
Begin
Writeln('Secondo Ordinamento Bubblesort');
m:=n-1;
For j:=1 to n-1 do
 begin
  For i:=1 to m do
   begin
   If V[i]>V[i+1] then Scambia(V[i],V[i+1]);
   end;
  m:=m-1;
  end;
Print(v);
Writeln;
Writeln;
End;
//-------------------------------------------
Procedure bubblesort3(V:Vettinteger);
var
 S:Boolean;
 i,m:Integer;
Begin
Writeln('Terzo ordinamento Bubblesort');
m:=n-1;
Repeat
 s:=false;
 For i:=1 to m do
  If V[i]>V[i+1] then
   begin
   scambia(V[i],V[i+1]);
   s:=true;
   end;
 m:=m-1;
Until s=false;
Print(v);
Writeln;
Writeln;
End;
//-------------------------------------------
Procedure Bubblesort4(V:VettInteger);
var
s:Boolean;
i,p,m:integer;
Begin
s:=False;
m:=n;
Writeln('Quarto ordinamento BubbleSort');
Repeat
s:=False;
 for i:=1 to m-1 do
  IF V[i]>V[i+1] then
   begin
   Scambia(V[i],V[i+1]);
   s:=true;
   p:=i+1;
   end;
  m:=p;
Until S=false;
Print(V);
Writeln;
Writeln;
end;
//-------------------------------------------
Procedure QuickSort(var V:VettInteger;L,R:integer);
Var
pivot:Integer;
i,j:integer;

Begin

i:=L; j:=R;
pivot:=(V[L]+V[R])div 2;
REPEAT
 While V[i]<Pivot do
  inc(i);
 While V[j]>pivot do
  dec(j);
 IF i<=j then
 begin
 Scambia(V[i],V[j]);
 Inc(i);
 Dec(j);
 end;
Until i>=j;
IF L<j then QuickSort(V,l,j);
IF R>i then Quicksort(V,i,r);
End;
//------------------------------------------------------------------------------
Procedure CountingSort(var V:VettInteger);
Type
 Vett=Array[1..100]of integer;
Var
 copia:VettInteger;
 b:Vett;
 i:integer;
Begin
//inizializzo il vettore

For i:=1 to 100 do
 B[i]:=0;
For i:=1 to n do
inc(B[V[i]]);
For i:=2 to 100 do
 B[i]:=B[i]+B[i-1];
For i:=n downto 1 do
 begin
 Copia[B[V[i]]]:=V[i];
 dec(B[v[i]]);
 end;
For i:=1 to n do
 V[i]:=copia[i]

End;
//------------------------------------------------------------------------------
Procedure Mergesort(Var V:VettInteger;L,R:integer);

  Procedure Merge(var V:VettInteger;L,posmed,R:Integer);
  Var
   i,j,k:integer;
   B:VettInteger;
  Begin
   i:=L;j:=PosMed+1;k:=L;
   While (I<=Posmed) and (j<=R) do
    begin
    If V[i]<V[j] then
      begin
      B[k]:=V[i];
      inc(i);
      end
    else
      begin
      B[k]:=V[j];
      inc(j);
      end;
      inc(k);
    end;
   while i<=posmed do
    begin
    B[k]:=V[i];
    inc(i);
    inc(k);
    end;
   While j<=r do
    begin
    B[k]:=V[j];
    inc(j);
    inc(k);
    end;
   For k:=l to r do
    V[k]:=B[k];
  End;                                                               {End MERGE}

Var
 PosMed:integer;
Begin
IF L<R then
 begin
 PosMed:=(L+R)div 2;
 Mergesort(V,L,PosMed);
 Mergesort(V,PosMed+1,R);
 Merge(V,L,PosMed,R);
 end;
End;




Var
  V1,V2,v3:VettInteger;
  i:integer;
begin
randomize;
Writeln('Programma che realizza i vari ordinamenti');
Writeln('Rimepimento del vettore:');
Genera(V1);
V2:=V1;
V3:=V1;
Print(V1);
writeln;
writeln;
Writeln('Invio pa'' ACCUMINCIARI');
readln;
selectionsort(V1);
Bubblesort1(V1);
Bubblesort2(V1);
Bubblesort3(V1);
Bubblesort4(V1);
Writeln('Ordinamento Quicksort');
QuickSort(V1,1,n);
Print(V1);
writeln;
writeln;
Writeln('Ordinamento Mergesort');
Mergesort(V2,1,n);
Print(v2);
writeln;

Writeln('Ordinamento CountingSort');
CountingSort(v3);
print(v3);


readln;
end.



Torna a Programmazione e Lab.

Non ci sono commenti in questa pagina. [Scrivi commento]

Valid XHTML 1.0 Transitional :: Valid CSS :: Powered by Wikka Wakka Wiki 1.1.6.1
La pagina è stata generata in 0.2412 secondi