voici les tri directe sur les fichier pour les éleves du bac

الموضوع في 'أرشيف المنتدى التعليمي' بواسطة THE_KiNG_OF_MiX, بتاريخ ‏13 نوفمبر 2008.

  1. THE_KiNG_OF_MiX

    THE_KiNG_OF_MiX عضو مميز

    إنضم إلينا في:
    ‏22 مارس 2006
    المشاركات:
    962
    الإعجابات المتلقاة:
    2.360
      13-11-2008 00:47
    voici les tri directe sur les fichier pour les éleves du bac​


    les 3 tri fonctionnent 100% en exécution pascal ​


    program triebull;
    uses wincrt;
    type
    f=file of integer;
    var
    t:f;
    e,i:integer;

    procedure trie (var t:f );
    var
    trier : boolean;
    i: integer;
    e,v:integer;
    begin
    repeat
    trier := true;
    for i := 0 to filesize (t)- 2 do
    begin
    seek (t,i);
    read (t,e);
    read (t,v);
    if e > v then
    begin
    trier := false;
    seek (t,i);
    write (t,v);
    write (t,e);
    end;
    end;

    until trier;
    end;

    begin
    assign(t,'c:\m.mxt');
    rewrite(t);
    for i:=1 to 20 do
    begin
    read(e);write(t,e);
    end;
    trie(t);
    reset(t);
    for i:=1 to 20 do
    begin
    read(t,e);
    write(e:4);
    end;
    end.




    program trieinsertion;
    uses wincrt;
    type
    f=file of integer;
    var
    t:f;
    e,i:integer;

    procedure decal(var t:f;d,e:integer);
    var
    i,v1,v2:integer;
    begin
    seek(t,e);read(t,v1);
    for i:=e downto d+1 do
    begin
    seek(t,i-1);
    read(t,v2);
    write(t,v2);
    end;
    seek(t,d);write(t,v1);
    end;
    procedure trie(var t:f);
    var
    i,j:integer;
    v1,v2,b:integer;
    begin
    reset(t);
    repeat
    b:=1;
    for i:=0 to (filesize(t)-1)-1 do
    begin
    seek(t,i);
    read(t,v1);
    for j:=i+1 to (filesize(t)-1)do
    begin
    seek(t,j);
    read(t,v2);
    if v1>v2 then
    begin
    decal(t,i,j);
    b:=0;
    end;
    end;
    end;
    until b=1;
    end;


    begin
    assign(t,'c:\m.mxt');
    rewrite(t);
    for i:=1 to 20 do
    begin
    read(e);write(t,e);
    end;
    trie(t);
    reset(t);
    for i:=1 to 20 do
    begin
    read(t,e);
    write(e:4);
    end;
    end.





    program trie_selection;
    uses wincrt;
    type
    f=file of integer;
    var
    fe:f;
    function min(var clas:f;x:integer):integer;
    var
    e1,e2,i,l:integer;
    begin
    seek(clas,x);
    read(clas,e1);
    l:=x;
    i:=x;
    while not(eof(clas)) do
    begin
    i:=i+1;
    seek(clas,i);
    read(clas,e2);
    if (e1<e2) then
    begin
    e1:=e2;
    l:=i;
    end;
    end;
    min:=l;
    end;
    {---------------------------------------------------------------------------------**
    procedure permut(var clas:f;x,y:integer);
    var
    e1,e2:integer;
    begin
    seek(clas,x);
    read(clas,e1);
    seek(clas,y);
    read(clas,e2);
    seek(clas,x);
    write(clas,e2);
    seek(clas,y);
    write(clas,e1);
    end;
    {-----------------------------------------------------------------------------**
    procedure tri(var clas:f);
    var
    i,m:integer;
    begin
    i:=-1;
    reset(clas);
    while not(eof(clas))do
    begin
    i:=i+1;
    m:=min(clas,i);
    permut(clas,m,i);
    end;

    end;
    {---------------------------------------------------------------------------**
    procedure ecrire(var moy:f);
    var
    i:integer;
    begin
    tri(moy);
    reset(moy);
    while not (eof(moy))do
    begin
    read(moy,i);
    write(i:10);
    end;
    end;
    procedure ouvrir(var moy:f);
    begin
    {$i-**reset(moy);{$i+**
    if ioresult <>0 then
    rewrite(moy);
    end;
    procedure lire(var moy:f);
    var
    c:char;
    e:integer;

    begin
    seek(moy,filesize(moy));
    repeat
    clrscr;
    writeln(' Engistrement des éléve');
    writeln('**********************************************************************');
    write('num:');readln(e);
    write(moy,e);
    writeln('pour quitter press echap');
    c:=readkey;
    until c=chr(27);

    end;
    begin
    assign(fe,'c:/m.txt');
    ouvrir(fe);
    lire(fe);
    ecrire(fe);
    end​
    .
     
    3 شخص معجب بهذا.
  2. anas sellami

    anas sellami عضو نشيط

    إنضم إلينا في:
    ‏4 فيفري 2007
    المشاركات:
    299
    الإعجابات المتلقاة:
    132
      13-11-2008 22:26
    merci pour ce travail mais ton sujet doit être encore organisé.
    merci quand même
     

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

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