matrice skal laves til en reduceret echelon matrice (matematik )

michael_g>> Hvis du rent matematisk kan forklare mig hvordan man gør. Så kan jeg kode det. Echelon matrice, lyder som gymnasiematematik, og det er altså mange (13) år siden jeg gik i gymnasiet. Så mange ting er glemt.

Jens B

Jeg har fundet en beskrivelse på nettet:
http://www.docjava.dk/matematik/linear_ligningssystemer/linear_ligningssystemer.htm
numrene i mit eksempel henviser til numrene i beskrivelsen.

Jeg har været nødt til at sætte en størrelse på matricen, da min version af delphi ikke kan håndtere ikkebestemte array størrelser.

Formen består af 2 stringgrids og 2 knapper (close og beregn)

I formcreate sættes størrelsen på de to stringgrids og der fyldes tal ind i den første. Jeg har valgt en 3x4 matrice.

closeknappen lukker formen. (flot ikke)

Når der trykkes på 'beregn'-knappen udføres reduktionen, og resultatet skrives i stringgrid2.

Håber du har et udregnet eksempel, så du kan kontrollere resultatet.

Og til eksemplet :




unit Echelonm;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    StringGrid2: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const
  n = 4;      {kolonner}
  m = 3;        {rækker}

type
  Tmatrix = record
    col : array[1..n] of extended;
end;

var
  Form1: TForm1;
  matrix : array[1..m] of Tmatrix;


implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  i,j: integer;

  begin
  with stringgrid1 do
  begin
    ColCount := n;
    RowCount := m;
    width := ColCount*DefaultColwidth+5;
    height := RowCount*DefaultRowHeight+5;
  end;
  with stringgrid2 do
  begin
    ColCount := n;
    RowCount := m;
    width := ColCount*DefaultColwidth+5;
    height := RowCount*DefaultRowHeight+5;
  end;
  stringgrid2.top := stringgrid1.top;
  stringgrid2.left := stringgrid1.left+stringgrid1.width+10;

  matrix[1].col[1] := 0;
  matrix[1].col[2] := 2;
  matrix[1].col[3] := 3;
  matrix[1].col[4] := 4;
  matrix[2].col[1] := 5;
  matrix[2].col[2] := 6;
  matrix[2].col[3] := 7;
  matrix[2].col[4] := 8;
  matrix[3].col[1] := 9;
  matrix[3].col[2] := 10;
  matrix[3].col[3] := 11;
  matrix[3].col[4] := 12;

  for i := 1 to n do
    for j := 1 to m do
      stringgrid1.cells[i-1,j-1] := Floattostrf(matrix[j].col[i],ffFixed,15,2);

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i,j,k : integer;
  temp : Tmatrix;
  ok,chk: boolean;
  x: extended;
begin
  ok := false;
  i := 1;                              {1}

  Repeat

    If matrix[i].col[i] = 0 then        {2}
    begin
      chk := false;
      for j := 1 to m do
      begin
        if ((j <> i) and ( matrix[j].col[i] <> 0)) then
        begin
          chk := true;
          temp := matrix[j];
          matrix[j] := matrix[i];
          matrix[i] := temp;
        end;
      end;
      if not chk then break;
    end;

    If matrix[i].col[i] <> 1 then        {3}
    begin
      for j := 1 to n do
        matrix[i].col[j] := matrix[i].col[j] / matrix[i].col[i];
    end;

    for j := 1 to m do                    {4}
    begin
      if (j <> i) then
      begin
        x := matrix[j].col[i];
        for k := 1 to n do
          matrix[j].col[k] := matrix[j].col[k]-x*matrix[i].col[k];
      end;
    end;


    if ((i = m) or (i=n)) then            {5}
    begin
      Ok := true;
      break;
    end;
    inc(i);                                {6}
  until i > m;
  if ok then
  begin
    for i := 1 to n do
      for j := 1 to m do
        stringgrid2.cells[i-1,j-1] := Floattostrf(matrix[j].col[i],ffFixed,15,2);
  end
  else
    showmessage('Matricen kan ikke reduceres');
end;

end.

hreiff: Jeg har lige prøvet at køre programmet. det eksempel som du har skrevet ind i programmet giver det forkerte resultat.
det giver:
[[1 , 0 , 0 , 2328]
[0 , 1 , 0 , -368]
[0 , 0 , 1 , 124]]

det rigtige resultat er:
[[1 , 0 , 0 , 0]
[0 , 1 , 0 , -1]
[0 , 0 , 1 , 2]]

jeg kan ikke lige se hvor det er det går galt i programmet, men beskrivelsen som du har fundet på nettet passer helt fint.

program echelon;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  matrix = array of array of extended;

procedure print(a : matrix);

var
  i, j : integer;

begin
  for i := low(a) to high(a) do begin
      for j := low(a[i]) to high(a[i]) do begin
        write(' ', a[i,j]:5:2);
      end;
      writeln;
  end;
end;

procedure rowswap(var a : matrix; i1, i2 : integer);

var
  j : integer;
  tmp : extended;

begin
  for j := low(a[i1]) to high(a[i1]) do begin
      tmp := a[i1,j];
      a[i1,j] := a[i2,j];
      a[i2,j] := tmp;
  end;
end;

procedure rowechelon(var a : matrix);

var
  i, j, k, ix : integer;
  x : extended;

begin
  for i := low(a) to high(a) do begin
      ix := i;
      while (a[ix,i] = 0) and (ix <= high(a)) do begin
        ix := ix + 1;
      end;
      if ix > high(a) then begin
        writeln('problem');
        halt;
      end;
      if ix <> i then begin
        rowswap(a, i, ix);
      end;
      x := a[i,i];
      for j := i to high(a[i]) do begin
        a[i,j] := a[i,j] / x;
      end;
      for k := (i + 1) to high(a) do begin
        x := a[k,i];
        for j := i to high(a[k]) do begin
            a[k,j] := a[k,j] - x * a[i,j];
        end;
      end;
  end;
end;

procedure reducedrowechelon(var a : matrix);

var
  i, j, k : integer;
  x : extended;

begin
  rowechelon(a);
  for i := high(a) downto (low(a) + 1) do begin
      for k := (i - 1) downto low(a) do begin
        x := a[k,i];
        for j := (k + 1) to high(a[i]) do begin
            a[k,j] := a[k,j] - x * a[i,j];
        end;
      end;
  end;
end;

var
  i : integer;
  a : matrix;

begin
  setlength(a, 3);
  for i := low(a) to high(a) do begin
      setlength(a[i], 4);
  end;
  a[0,0] := 0;
  a[0,1] := 2;
  a[0,2] := 3;
  a[0,3] := 4;
  a[1,0] := 5;
  a[1,1] := 6;
  a[1,2] := 7;
  a[1,3] := 8;
  a[2,0] := 9;
  a[2,1] := 10;
  a[2,2] := 11;
  a[2,3] := 12;
  writeln('start:');
  print(a);
  rowechelon(a);
  writeln('efter rowechelon:');
  print(a);
  reducedrowechelon(a);
  writeln('efter reducedrowechelon:');
  print(a);
end.

start:
  0.00  2.00  3.00  4.00
  5.00  6.00  7.00  8.00
  9.00 10.00 11.00 12.00
efter rowechelon:
  1.00  1.20  1.40  1.60
  0.00  1.00  1.50  2.00
  0.00  0.00  1.00  2.00
efter reducedrowechelon:
  1.00  0.00  0.00  0.00
  0.00  1.00  0.00 -1.00
  0.00  0.00  1.00  2.00

Hej Arne_V!
Dit eksempel virker fint med nogen matricer, men hvis jeg f.eks.  prøver at reducere matricerne:
[[1 , 1 , 1 , 1]
[1 , 1 , 1 , 1]
[1 , 1 , 1 , 1]]

eller

[[1 , 2 , 3 , 4]
[5 , 6 , 7 , 8]
[9 , 10 , 11 , 12]]

så laver den en access violation fejl

Byt om på de to betingelser i while løkken.

      while (ix <= high(a)) and (a[ix,i] = 0) do begin
        ix := ix + 1;
      end;

så virker det.

Ny komplet kode:

program echelon;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  matrix = array of array of extended;

procedure print(a : matrix);

var
  i, j : integer;

begin
  for i := low(a) to high(a) do begin
      for j := low(a[i]) to high(a[i]) do begin
        write(' ', a[i,j]:5:2);
      end;
      writeln;
  end;
end;

procedure rowswap(var a : matrix; i1, i2 : integer);

var
  j : integer;
  tmp : extended;

begin
  for j := low(a[i1]) to high(a[i1]) do begin
      tmp := a[i1,j];
      a[i1,j] := a[i2,j];
      a[i2,j] := tmp;
  end;
end;

procedure rowechelon(var a : matrix);

var
  i, j, k, ix : integer;
  x : extended;

begin
  for i := low(a) to high(a) do begin
      ix := i;
      while (ix <= high(a)) and (a[ix,i] = 0) do begin
        ix := ix + 1;
      end;
      if ix > high(a) then begin
        writeln('problem');
        halt;
      end;
      if ix <> i then begin
        rowswap(a, i, ix);
      end;
      x := a[i,i];
      for j := i to high(a[i]) do begin
        a[i,j] := a[i,j] / x;
      end;
      for k := (i + 1) to high(a) do begin
        x := a[k,i];
        for j := i to high(a[k]) do begin
            a[k,j] := a[k,j] - x * a[i,j];
        end;
      end;
  end;
end;

procedure reducedrowechelon(var a : matrix);

var
  i, j, k : integer;
  x : extended;

begin
  rowechelon(a);
  for i := high(a) downto (low(a) + 1) do begin
      for k := (i - 1) downto low(a) do begin
        x := a[k,i];
        for j := (k + 1) to high(a[i]) do begin
            a[k,j] := a[k,j] - x * a[i,j];
        end;
      end;
  end;
end;

var
  i : integer;
  a : matrix;

begin
  setlength(a, 3);
  for i := low(a) to high(a) do begin
      setlength(a[i], 4);
  end;
  (*
  a[0,0] := 0;
  *)
  a[0,0] := 1;
  a[0,1] := 2;
  a[0,2] := 3;
  a[0,3] := 4;
  a[1,0] := 5;
  a[1,1] := 6;
  a[1,2] := 7;
  a[1,3] := 8;
  a[2,0] := 9;
  a[2,1] := 10;
  a[2,2] := 11;
  a[2,3] := 12;
  writeln('start:');
  print(a);
  rowechelon(a);
  writeln('efter rowechelon:');
  print(a);
  reducedrowechelon(a);
  writeln('efter reducedrowechelon:');
  print(a);
end.

Virker er iøvrigt så meget sagt.

Outputttet er

start:
  1.00  2.00  3.00  4.00
  5.00  6.00  7.00  8.00
  9.00 10.00 11.00 12.00
problem

fordi række3 = 2 * række2 - række1

Det var ikke mange point man kunne få for alt fodarbejdet.

Fejlen i mit program ligger i sektion 3. Der skal stå
      x := matrix[i].col[i];
      for j := 1 to n do
      begin
        matrix[i].col[j] := matrix[i].col[j] / x;
ellers deles der med et forkert tal når j > i.
Iøvrigt bør If-sætningerne tilpasses floating point:
If matrix[i].col[i]=0 then  ændres til If abs(matrix[i].col[i])<0.00001 then 
   
Så får du det rigtige resultat:
[1 , 2 , 3 , 4]  [1,0,-1,-2]
[5 , 6 , 7 , 8]  [0,1, 2, 3]
[9 ,10 ,11 ,12]  [0,0, 0, 0]  (kan ikke reduceres fuldt)
(ret så udskrivningen køres altid)
eller
[1 , 2 , 3 , 4]  [1,0,0,-1]
[5 , 6 , 7 , 8]  [0,1,0, 1]
[9 ,10 ,12 ,13]  [0,0,1, 1]  (fuldt reduceret)