RÉSOLUTION D'UN SYSTÈME LINÉAIRE NXP PAR LA MÉTHODE DU PIVOT DE GAUSS (DIAGONALISATION)

Commentaire de f0xi le 15/10/2008 23:29:00 administrateur CS

princ.pas ::

unit princ;

interface

uses
  Windows, Messages, SysUtils,declarations,fichier, Classes, Graphics, Controls,
  Forms,apropos, Dialogs,filectrl,StdCtrls, ExtCtrls, Menus, ComCtrls, ToolWin, ImgList, ActnList,
  Gauges;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Edition1: TMenuItem;
    Creerunematrice1: TMenuItem;
    Ouvrir1: TMenuItem;
    editer: TMenuItem;
    enregistrer: TMenuItem;
    apropos: TMenuItem;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    N1: TMenuItem;
    quitter2: TMenuItem;
    ouvrirdialog: TOpenDialog;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ImageList1: TImageList;
    editerdialog: TOpenDialog;
    editionfin: TButton;
    resol: TButton;
    Edit1: TEdit;
    procedure Timer1Timer(Sender: TObject);
    procedure Creerunematrice1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure editerClick(Sender: TObject);
    procedure quitter1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StatusBar1Click(Sender: TObject);
    procedure Ouvrir1Click(Sender: TObject);
    procedure enregistrerClick(Sender: TObject);
    procedure ouvrirdialogCanClose(Sender: TObject; var CanClose: Boolean);
    procedure editerdialogCanClose(Sender: TObject; var CanClose: Boolean);
    procedure editionfinClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure editerdialogClose(Sender: TObject);
    procedure resolClick(Sender: TObject);
    procedure aproposClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}


procedure TForm1.Timer1Timer(Sender: TObject);
var
h,m,s,z : word;
begin
  decodetime(now, h,m,s,z);

  statusbar1.Panels[3].text := format('horloge : %.2d:%.2d:%.2d',[h, m, s]);

  { calcul du temps passé.
  }
  Inc(SecUtil);
  if SecUtil >= 60 then
  begin
    SecUtil := 0;
    Inc(MinUtil);
  end;
  if MinUtil >= 60 then
  begin
    MinUtil := 0;
    Inc(HeureUtil);
  end;
  statusbar1.Panels[1].text:= format('temps passé : %.2d:%.2d:%.2d',[HeureUtil, MinUtil, SecUtil]);
end;

procedure TForm1.Creerunematrice1Click(Sender: TObject);
var
  v: string;
begin
  // creer un système.Gestion des exceptions.
  v := InputBox('nombre de lignes',
                'entrer le nombre de lignes :',
                '5');
  dim.ligne := StrToIntDef(v, 3);

  v := InputBox('nombre de colonnes',
                'entrer le nombre de colonnes :',
                '3');
  dim.colonne:=StrToIntDef(v, 6);

  if dim.ligne < 1 then
    dim.ligne := 3
  else
  if dim.ligne > 24 then
    dim.ligne := 24;

  if dim.colonne < 1 then
    dim.colonne := 3
  else
  if dim.colonne > 24 then
    dim.colonne := 24;

  v := inputbox('nom de la matrice',
                'entrer le nom (sans .txt):',
                'GMP04');
  // supprimer l'extension
  v := ChangeFileExt(V, '.txt');

  CreerMat(v);
  NomCour := v;
  v := ExtractFilePath(Application.ExeName);
  v := v+'matrices\'+NomCour;

  memo1.visible := true;
  memo1.lines.loadfromfile(v);
  statusbar1.panels[0].text := NomCour;
  editionfin.visible := true;
end;

procedure TForm1.editerdialogCanClose(Sender: TObject; var CanClose : Boolean);
var v,nom    : string;
begin
  memo1.Visible := true;
  editionfin.visible := true;
  v := ExtractFilePath(Application.ExeName);
  v := v+'matrices\';
  nom := editerdialog.filename;
  delete(nom, 1, length(v));
  statusbar1.panels[0].text := Nom;
  NomCour := Nom;
  Ouvrir(NomCour);
  memo1.visible := true;
  memo1.lines.loadfromfile(editerdialog.filename);
end;

procedure TForm1.editionfinClick(Sender: TObject);
var
  v : string;
begin
  toolbar1.visible:=true;
  // extension complète ...
  v := extractfilepath(application.exename);
  v := v+'matrices\'+nomcour;
  memo1.lines.SaveToFile(v);
  editionfin.Visible := false;
  memo1.visible      := false;
  ouvrir(nomcour);
  statusbar1.panels[0].text:=nomcour;
  Paint;

  //initialisation des variables globales.
  rang   := 0;
  etape1 := false;
  etape2 := true;
  etape3 := true;
  etape4 := true;
  etape5 := true;
  pivot  := false;
end;
/////////////////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Visible := false;
  editionfin.visible := false;
  if nomcour = 'matricecour.txt' then
    ouvrir('matricecour.txt')
  else
  if nomcour = 'acreer' then
  begin
     sauver('matricecour.txt');
     sauver('matrice3x3.txt');
  end;
  nomcour := 'matricecour.txt';
  statusbar1.Panels[0].text:=nomcour;
end;

procedure TForm1.editerClick(Sender: TObject);
begin
  toolbar1.visible:=false;
  editerdialog.initialdir:=application.ExeName+'matrices\';
  editerdialog.filename:='matricecour.txt';
  editerdialog.execute;
end;

procedure TForm1.quitter1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  tps : textfile;
  chemin : string;
begin
  chemin := extractfilepath(application.exename)+'tempspasse\tpspasse.txt';
  assignfile(tps,chemin);
  rewrite(tps);
  writeln(tps,inttostr(heureutil));
  writeln(tps,inttostr(minutil));
  writeln(tps,inttostr(secutil));
  closefile(tps);
  nomcour := 'matricecour.txt';
  sauver(nomcour);
end;

procedure TForm1.StatusBar1Click(Sender: TObject);
begin
  // changer le nom de matricecour.text
  nomcour:=entrernom('autre nom sans .txt','entrer un nouveau nom pour le syst. courant');
  statusbar1.panels[0].text:=nomcour;
  sauver(nomcour);
end;

procedure TForm1.Ouvrir1Click(Sender: TObject);
begin
  // Ouvrir
  //sauver(nomcour);
  pivot:=false;
  ouvrirdialog.initialdir:=application.ExeName+'matrices\';
  ouvrirdialog.filename:='matricecour.txt';
  ouvrirdialog.execute;
end;

procedure TForm1.enregistrerClick(Sender: TObject);
var
  nom : string;
begin
  // Enregistrer
  nom:='matcour.txt';
  nom:=entrernom('nom du système','donner un nom de fichier sans extension :');
  sauver(nom);
end;

procedure TForm1.ouvrirdialogCanClose(Sender: TObject; var CanClose: Boolean);
var
  v,nom: string;
begin
  //sauver(nomcour);
  v:=extractfilepath(application.exename);
  v:=v+'matrices\';
  nom:=ouvrirdialog.filename;
  delete(nom,1,length(v));
  ouvrir(nom);
  statusbar1.panels[0].text:=nom;
  nomcour:=nom;
  Paint;
  rang:=0;
  etape1:=false;
  etape2:=true;
  etape3:=true;
  etape4:=true;
  etape5:=true;
  pivot:= false;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  coul : tcolor;
begin
  efface(canvas,posa);
  if (dim.colonne>0) and (dim.colonne<13) then
  begin
    larg:=80;
    haut:=30;
  end
  else
  if (dim.colonne>12) and (dim.colonne<20) then
  begin
    larg:=50;
    haut:=30;
  end
  else
  if (dim.colonne>19) and (dim.colonne<25) then
  begin
    larg:=40;
    haut:=20;
  end;

  posa.dx := 10;
  posa.dy := 50;
  posb.dx := posa.dx;
  posb.dy := posa.dy+haut;
  posc.dy := posb.dy;
  posc.dx := posb.dx+ dim.colonne*larg;
  efface(canvas,posa);
  coul := clred;
  affichemat(canvas,posb,coul);
  coul := clgreen;
  affichevect(canvas,posc,coul);
  coul := clblue;
  affichinc(canvas,posa,coul);
end;

procedure TForm1.editerdialogClose(Sender: TObject);
begin
  toolbar1.visible:=true;
end;

procedure TForm1.resolClick(Sender: TObject);
var
  i,j : integer;
  a,coef : extended;
  b,pivot_af : string;
begin
  // à l'initialisation toutes les étapes sont true sauf etape1 à false.
  // étape 5
  if not Etape5 then
    Etape1 := false;

  // étape 4,élimination des coef. de la colonne pivot : Li=Li-aij*Lipiv.
  if not Etape4 then
  begin

    edit1.text := 'élimination des coef. de la colonne pivot(rang='+inttostr(rang)+')';
    sleep(2000);

    for i:= 1 to dim.ligne do
    begin
      if i <> ipiv then
      begin
        coef:= mat[i,jpiv];
        for j := 1 to dim.colonne do
          mat[i,j]:= mat[i,j]-coef*mat[ipiv,j];
        vect[i]:=vect[i]-vect[ipiv]*coef;
      end;
    end;
    paint;

    if rang = dim.ligne then
     etape4 := true
    else
    begin
      etape4 := true;
      etape5 := false;
      pivot  := false;
    end;
  end;

  // étape 3, division de la ligne par le pivot.
  if not Etape3 then
  begin
    edit1.text:= format('division de la ligne %d par le pivot. (%.3f)',[ipiv, mat[ipiv,jpiv]]);
    sleep(1000);
    for j := 1 to dim.colonne do
      mat[ipiv,j]:=mat[ipiv,j]/a;
    vect[ipiv]:=vect[ipiv]/a;
    paint;
    etape3 := true;
    etape4 := false;
  end;

  // étape 2, permutation des lignes ou colonnes.
  if not Etape2 then
  begin
    edit1.text:='ipiv ='+inttostr(ipiv);
    if ipiv<>rang then
    begin
      edit1.text:='permutation des lignes '+inttostr(rang)+' et '+inttostr(ipiv);
      sleep(1000);
      for j:=1 to dim.colonne do
      begin
        a:= mat[rang,j];
        mat[rang,j]:= mat[ipiv,j];
        mat[ipiv,j]:= a;
      end;
      a:=vect[rang];
      vect[rang]:=vect[ipiv];
      vect[ipiv]:=a;
    end;
    if jpiv<>rang then
    begin
      edit1.text:='permutation des colonnes'+inttostr(rang)+'et'+inttostr(jpiv);
      sleep(2000);
      for i:=1 to dim.ligne do
      begin
        a:= mat[i,rang];
        mat[i,rang]:= mat[i,jpiv];
        mat[i,jpiv]:= a;
      end;
      b:=StrInc[rang];
      StrInc[rang]:=StrInc[jpiv];
      StrInc[jpiv]:=b;
    end;
    Paint;
    ipiv:=rang;
    jpiv:=rang;
    etape2:=true;
    etape3:=false;
  end;

  // étape 1, recherche du pivot dans une sous-matrice complète.
  if not Etape1 then
  begin
    for j := rang+1 to dim.colonne do
      for i:= rang+1 to dim.ligne do
        if not pivot then
          if mat[i,j] <> 0 then
          begin
            pivot:= true;
            inc(rang);
            ipiv:=i;
            jpiv:=j;
          end;
    if pivot=true then
    begin
      edit1.text:= format(' pivot trouvé %d, %d = %.3f',[ipiv, jpiv, mat[ipiv,jpiv]]);
      sleep(1000);
    end;

    if (not pivot) and (rang = 0) then
      edit1.text:='rang nul';

    if (not pivot) and (rang <> 0) then
      edit1.text:='rang de ce syst. linéaire = '+inttostr(rang);

    if pivot then
      if (ipiv<> rang) or (jpiv<> rang) then
      begin
        edit1.text := format('permutation %d%d',[ipiv,jpiv]);
        etape1:=true;
        etape2:=false;
      end
      else
      begin
//        edit1.text:='division de la ligne '+inttostr(ipiv)+'par le pivot';
        etape1 := true;
        etape3 := false;
      end;
  end;
end;

procedure TForm1.aproposClick(Sender: TObject);
begin
  form3.show;
end;

end.
_____________________________________________________________

declarations.pas ::

unit declarations;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,filectrl, Menus, ComCtrls, ToolWin, ImgList, ActnList;

type
  TStrInc  = array[1..100] of string;
  TMat  = array[1..100,1..100] of extended;
  TVect = array[1..100] of extended;
  TDim = record
    ligne, colonne : integer;
  end;

  TPos = record
    dx,dy : integer;
  end;

var
  SecUtil,MinUtil,HeureUtil : integer;
  tps : textfile;
  chemin,nomcour : string;
  dim : TDim;
  mat : TMat;
  vect : TVect;
  StrInc : TStrInc;
  larg,haut : integer;
  ipiv,jpiv,m,p : integer;

  rang : integer = 0;

  posa : TPos = (dx:50; dy:50);
  posb : TPos = (dx:50; dy:80);
  posc : TPos = (dx:260; dy:80);

  //Etapes de progression de la résolution
  etape1: boolean = false;
  etape2: boolean = true;
  etape3: boolean = true;
  etape4: boolean = true;
  etape5: boolean = true;
  pivot : boolean = false;

implementation

initialization
  // Essai d'ouverture du fichier tpspasse.txt
  // Si le rep. contenant tpspasse.txt n'existe pas il faut le créer : forcedirectories...
  chemin := extractfilepath(application.exename);
  chemin := chemin+'tempspasse\tpspasse.txt';

  if FileExists(chemin) then
  begin
    assignfile(tps,chemin);
    reset(tps);
    readln(tps,HeureUtil);
    readln(tps,MinUtil);
    readln(tps,SecUtil);
    closefile(tps);
  end
  else
  begin
    //création du répertoire tempspassé
    HeureUtil:=0;
    MinUtil:=0;
    SecUtil:=0;
    chemin:= extractfilepath(application.exename);
    chemin:=chemin+'tempspasse\';
    forcedirectories(chemin);
  end;

  // essai d'ouverture de matricecour.txt
  chemin:=extractfilepath(application.exename);
  chemin:=chemin+'matrices\matricecour.txt';
  if FileExists(chemin) then
  begin
    assignfile(tps,chemin);
    reset(tps);
    // traitement chargement des coefficients depuis matricecour.txt.
    nomcour:='matricecour.txt';
    closefile(tps);
  end
  else
  begin
    // création du répertoire  matrices.
    nomcour:='acreer';
    chemin:= extractfilepath(application.exename);
    chemin:=chemin+'matrices\';
    forcedirectories(chemin);
    dim.ligne:=3;
    dim.colonne:=3;

    //initialisation des coefficients.
    mat[1,1]:=1;
    mat[1,2]:=2;
    mat[1,3]:=3;
    mat[2,1]:=4;
    mat[2,2]:=5;
    mat[2,3]:=6;
    mat[3,1]:=7;
    mat[3,2]:=8;
    mat[3,3]:=9;

    vect[1]:=5;
    vect[2]:=6;
    vect[3]:=7;

    StrInc[1]:='x1';
    StrInc[2]:='x2';
    StrInc[3]:='x3';

    ipiv:=1;
    jpiv:=1;
  end;
end.