tout les tri solution uterative et recursive

الموضوع في 'أرشيف المنتدى التعليمي' بواسطة hamma0011, بتاريخ ‏17 جانفي 2009.

حالة الموضوع:
مغلق
  1. hamma0011

    hamma0011 نجم المنتدى

    إنضم إلينا في:
    ‏29 أوت 2008
    المشاركات:
    1.827
    الإعجابات المتلقاة:
    3.580
      17-01-2009 22:33
    program mohamed;
    uses wincrt;
    type tab =array [1..100] of integer;
    var t : tab ;
    n,p,temp,choi,max,i:integer;
    ech:boolean;
    procedure remplir (var n : integer; var t: tab);
    var i : integer;
    begin
    writeln ('donner n' );
    readln (n);
    writeln ('remplire t');
    for i := 1 to n do
    readln (t);
    end;
    procedure permut (var a,b :integer);
    var aux : integer;
    begin
    aux := a;
    a:=b;
    b := aux;
    end;
    function preposmax(d,f:integer;t:tab):integer;
    var posmax,j :integer;
    begin
    posmax :=d;
    for j := d+1to f do
    if t[posmax]<t[j]
    then
    posmax:=j;
    preposmax:=posmax;
    end;
    procedure tri_sel(n: integer;var t:tab);
    var i ,ppm:integer;
    begin
    for i:=1 to n do
    begin
    ppm:=preposmax(i,n,t);
    if t[ppm]<>t
    then
    permut (t[ppm], t);
    end;
    writeln ('la resultat est décroisante=') ;
    for i := 1 to n do
    writeln (t);
    end;
    procedure tri_ins(n:integer;var t:tab);
    var i,j,v:integer;
    begin
    for i := 1 to n do
    begin
    v:=t;
    j:=i;
    while ((t[j-1] >v)and (j> 1))do
    begin t[j]:=t[j-1];
    j:=j-1;
    end;
    t[j]:=v;
    end;
    writeln ('la resultat é croisante=') ;
    for i := 1 to n do
    writeln (t);
    end;

    Procedure Tri_bulles (var t : TAB; n : integer);
    Var i, aux : integer;
    Function Trier (t : TAB; n : integer) : Boolean;
    Var ok : boolean; i : integer;
    Begin
    ok := true; i := 1;
    Repeat
    If t[i + 1] < t Then ok := false
    Else i := i + 1;
    Until ((Not ok) or (i >= n));
    Trier := ok;
    End;
    Begin
    If Not Trier (t, n) Then
    Begin
    For i := 1 To n - 1 Do
    If t > t[i + 1] Then
    Begin
    aux := t;
    t := t[i + 1];
    t[i + 1] := aux;
    End;
    Tri_bulles (t, n);
    End;
    End;
    procedure tri_bull(var t:tab;n:integer);
    var i:integer;
    begin
    repeat
    ech:= false;
    for i:= 1 to n do
    if t<t[i+1]
    then
    begin
    permut (t,t[i+1]);
    ech:= true;
    end;
    until ech =false;
    writeln ('la resultate est decroisantr');
    for i:=1 to n do
    writeln (t);
    end;
    procedure tri_ins_rec(var t:tab; n:integer);
    var i,j,tmp:integer;
    begin
    if n>1 then
    tri_ins_rec(t,n-1);
    tmp:=t[n];
    j:=n;
    while (j>1) and (t[j-1]>tmp) do
    begin
    t[j]:=t[j-1];
    j:=j-1;
    end;
    t[j]:=tmp;

    end;
    procedure tri_chell_rec(var t:tab;n:integer);
    var i,j,tmp,p:integer;
    begin
    p:=0;
    while p<n do
    begin
    p:=(p*3)+1;
    end;
    while p<>0 do
    begin
    p:=p div 3;
    if n>1 then
    begin

    tri_chell_rec(t,n-1);
    tmp:=t[n];
    j:=n;
    while (j>p) and (t[j-p]>tmp) do
    begin
    t[j]:=t[j-p];
    j:=j-p;
    end;
    t[j]:=tmp;
    end;
    end;

    end;


    function maxi( m,n:integer;t:tab):integer;
    var i:integer;
    begin
    max:= m;
    for i:= m+1 to n do
    if max<t
    then maxi:=t;
    end;
    procedure tri_sel_rec(var t:tab;deb,fin:integer);
    var i:integer;
    begin
    max:=maxi (fin,deb,t);
    if deb<>max then
    begin
    permut(max,deb);
    end;
    if deb+1<> fin then
    tri_sel_rec (t,deb+1,fin);

    end;
    procedure aff(t:tab;n:integer);
    var i:integer;
    begin
    writeln('voila la resultat');
    for i:=1 to n do
    write ('|',t,'|');
    end;
    procedure tri_chell(var t:tab;n:integer);
    var i,p,j,tmp:integer;
    begin
    p:=0;
    while p<=n do
    begin
    p:=3*p+1;
    end;
    while p<>0 do
    begin
    p:=p div 3;
    for i:=(p+1) to n do
    begin
    tmp:=t;
    j:=i;
    while (t[j-p]>tmp) and (j>p) do
    begin
    t[j]:=t[j-p];
    j:=j-p
    end;
    t[j]:=tmp;
    end;
    end;
    end;

    begin

    repeat
    writeln ('1 tri a bulle');
    writeln ('2 tri a bulle recursive');
    writeln ('3 tri a insertion');
    writeln ('4 tri a insertion recursive');
    writeln ('5 tri a selection');
    writeln ('6 tri a selection recursive');
    writeln ('7 tri a chell');
    writeln ('8 tri a chell recursive');


    writeln ('donner le choi');
    readln(choi);

    until choi in [1..8];
    remplir(n,t);
    if choi=1 then
    begin
    tri_bull(t,n);
    aff(t,n)
    end
    else
    if choi =5 then
    tri_sel(n,t)
    else
    if choi =4 then
    begin
    tri_ins_rec(t,n);
    aff(t,n)
    end
    else
    if choi =3 then
    begin
    tri_ins(n,t) ;
    aff(t,n)
    end
    else
    if choi =2 then
    begin
    Tri_bulles(t,n);
    aff(t,n);
    end
    else
    if choi=6 then
    tri_sel_rec( t,1,n)
    else
    if choi =8 then
    begin
    tri_chell_rec( t,n);
    aff(t,n)
    end
    else
    if choi =7 then
    begin
    tri_chell( t,n);
    aff(t,n);
    end

    end.
     
    1 person likes this.
  2. pascal878

    pascal878 عضو نشيط

    إنضم إلينا في:
    ‏24 نوفمبر 2008
    المشاركات:
    104
    الإعجابات المتلقاة:
    33
      02-02-2009 23:18
    plus d'organisation
     
  3. helper2

    helper2 عضو مميز

    إنضم إلينا في:
    ‏30 نوفمبر 2008
    المشاركات:
    1.284
    الإعجابات المتلقاة:
    4.441
      03-02-2009 08:45
حالة الموضوع:
مغلق

مشاركة هذه الصفحة

جاري تحميل الصفحة...