Kalkulator macierzowy.

Odpowiedz Nowy wątek
2012-11-10 16:56
0

Cześć, piszę kalkulator macierzowy i nie mogę wymyślić algorytmu liczącego odwrotności macierzy, a ten co wymyśliłem coś go źle liczy. Nie jest ten program jeszcze optymalny ( wywala go gdy jest 0 na przekatnej), ale nie z tym mam problem. Proszę o pomoc zarówno w algorytmie jak i w ocenieniu składni

//Program robiacy proste dzialania na macierzach

program project1;
uses crt;
const n=100;
type
  macierz1 = array [0..n, 0..n] of real;
  macierz2 = array [0..n, 0..n] of real;
  macierz3 = array [0..n, 0..n] of real;
var
  k1,k2,w1,w2,min,menu,warunek : integer;
  mac1:macierz1;
  mac2:macierz2;
  mac3:macierz3;

//======nadawanie i wypisywanie wartosci macierzy========

procedure  wartosci(var m1:macierz1; var m2:macierz2);
var
  i,j:integer;

  begin
    writeln;
    writeln('Macierz pierwsza:');

      for i := 0 to w1-1 do
          begin
               for j := 0 to k1-1 do
                   begin
                    m1[i,j] := random(10);
                    write(m1[i,j],' ');
                   end;
            writeln();
          end;

    writeln;
    writeln('Macierz druga:');

      for i := 0 to w2-1 do
          begin
               for j := 0 to k2-1 do
                   begin
                    m2[i,j] := random(10);
                    write(m2[i,j],' ');
                   end;
            writeln();
          end;

  end;

  //=========== dodawanie ============================

procedure dodawanie(m1:macierz1; m2:macierz2; var m3:macierz3);
 var
   i,j:integer;
 begin
      if ((w1=w2) and (k1=k2)) then
         begin
                for i := 0 to w1-1 do
                  begin
                       for j := 0 to k1-1 do
                           begin
                               m3[i,j]:=m1[i,j]+m2[i,j];
                               write(m3[i,j],' ');

                           end;
                      writeln();
                  end;

         end
      else
          begin
            writeln('Na podstawie wprowadzonych danych nie da sie dodac tych macierzy.');
            writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
            read(warunek);
            writeln();
          end;

 end;

  //=========== odejmowanie ============================

 procedure odejmowanie(m1:macierz1; m2:macierz2; var m3:macierz3);
  var
    i,j:integer;
  begin
       if ((w1=w2) and (k1=k2)) then
          begin
                 for i := 0 to w1-1 do
                   begin
                        for j := 0 to k1-1 do
                            begin
                                m3[i,j]:=m1[i,j]-m2[i,j];
                                write(m3[i,j],' ');

                            end;
                       writeln();
                   end;

          end
       else
           begin
             writeln('Na podstawie wprowadzonych danych nie da sie odjac tych macierzy.');
             writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
             read(warunek);
             writeln();
           end;

  end;

  //=========== mnozenie ============================

 procedure mnozenie(m1:macierz1; m2:macierz2; var m3:macierz3);
  var
    i,j,k:integer;
    s:real        ;
  begin
       if (w1=k2) then
          begin
                 for i := 0 to w1-1 do
                   begin
                        for j := 0 to k2-1 do
                            begin
                              s:=0;
                              for k:=0 to w2-1 do
                                   begin
                                      s:=s+m1[i,k] * m2[k,j];

                                   end;
                              m3[i,j]:=s;
                              write(m3[i,j],' ');

                            end;
                       writeln();
                   end;

          end
       else
           begin
             writeln('Na podstawie wprowadzonych danych nie da sie pomnozyc tych macierzy.');
             writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
             read(warunek);
             writeln();
           end;
end;

     //=========== odwrotnosc ============================

 procedure odwrotnosc1(m1:macierz1; var m3:macierz3);
  var
    a,i,j,k :integer;
  begin
       if (w1=k1) then
         begin

                   for i:=0 to w1-1 do
                    begin
                         for j:=0 to w1-1 do
                             begin
                               m3[i,j]:=0
                             end;
                          m3[i,i]:=1;
                 end;

                 for i := 0 to w1-1 do
                   begin
                        for j := 0 to w1-1 do
                            begin
                                m3[i,j]:=m3[i,j]/m1[i,i];
                                m1[i,j]:=m1[i,j]/m1[i,i];
                            end;

                        for k:=i+1 to w1-1 do
                           begin
                               for j:=0 to w1-1 do
                                  begin
                                    m3[k,j]:= m3[k,j] -(m3[i,j]*m1[k,i]);
                                    m1[k,j]:= m1[k,j] -(m1[i,j]*m1[k,i]);

                                  end;
                           end;

                        if(i>0) then
                           for k:=i-1 downto 0 do
                              begin
                                  for j:=0 to w1-1 do
                                     begin
                                          m3[k,j]:=m3[k,j]-m3[i,j]*m1[k,i];
                                          m1[k,j]:=m1[k,j]-(m1[i,j]*m1[k,i]);
                                     end;
                              end;

                   end;
                 for i := 0 to w1-1 do
                  begin
                   for j := 0 to k1-1 do
                     begin
                      write(m3[i,j],' ');
                     end;
                   writeln();
                  end;

         end
       else
           begin
             writeln('Na podstawie wprowadzonych danych nie da sie odwrocic tej macierzy.');
             writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
             read(warunek);
             writeln();
           end;
       end;

 procedure odwrotnosc2(m1:macierz2; var m3:macierz3);
  var
    a,i,j,k :integer;
  begin
       if (w1=k1) then
         begin

                   for i:=0 to w1-1 do
                    begin
                         for j:=0 to w1-1 do
                             begin
                               m3[i,j]:=0
                             end;
                          m3[i,i]:=1;
                 end;

                 for i := 0 to w1-1 do
                   begin
                        for j := 0 to w1-1 do
                            begin
                                m3[i,j]:=m3[i,j]/m1[i,i];
                                m1[i,j]:=m1[i,j]/m1[i,i];
                            end;

                        for k:=i+1 to w1-1 do
                           begin
                               for j:=0 to w1-1 do
                                  begin
                                    m3[k,j]:= m3[k,j] -(m3[i,j]*m1[k,i]);
                                    m1[k,j]:= m1[k,j] -(m1[i,j]*m1[k,i]);

                                  end;
                           end;

                        if(i>0) then
                           for k:=i-1 downto 0 do
                              begin
                                  for j:=0 to w1-1 do
                                     begin
                                          m3[k,j]:=m3[k,j]-m3[i,j]*m1[k,i];
                                          m1[k,j]:=m1[k,j]-(m1[i,j]*m1[k,i]);
                                     end;
                              end;

                   end;
                 for i := 0 to w1-1 do
                  begin
                   for j := 0 to k1-1 do
                     begin
                      write(m3[i,j],' ');
                     end;
                   writeln();
                  end;

         end
       else
           begin
             writeln('Na podstawie wprowadzonych danych nie da sie odwrocic tej macierzy.');
             writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
             read(warunek);
             writeln();
           end;
       end;

begin
  clrscr;
  randomize;

  repeat
  warunek:=1;
  clrscr;
  min:=0;

  write('Wpisz liczbe wierszy macierzy pierwszej: ');
  readln(w1);
  write('Wpisz liczbe kolumn macierzy pierwszej: ');
  readln(k1);

  write('Wpisz liczbe wierszy macierzy drugiej: ');
  readln(w2);
  write('Wpisz liczbe kolumn macierzy drugiej: ');
  readln(k2);

  if ((w1>min) and (k1>min) and (w2>min) and (k2>min)) then
    begin
       writeln('Teraz nadaje im przypadkowe wartosci:');
       wartosci(mac1, mac2);
       writeln('Podaj jaki typ dzialania chcesz wykonac:');
       writeln('0 - dodawanie');
       writeln('1 - odejmowanie');
       writeln('2 - mnozenie');
       writeln('3 - odwrotnosc macierzy pierszej');
       writeln('4 - odwrotnosc macierzy drugiej');
       writeln('9 - ponowne wporwadzenie danych');
       writeln('inna liczba - wyjscie');
       readln(menu);

       if(menu=0) then
         begin
            dodawanie(mac1,mac2,mac3);
         end

       else if(menu=1) then
         begin
             odejmowanie(mac1,mac2,mac3);
         end

       else if(menu=2) then
         begin
             mnozenie(mac1,mac2,mac3);
         end

       else if(menu=3) then
         begin
             odwrotnosc1(mac1,mac3);

         end

       else if(menu=4) then
         begin
             odwrotnosc2(mac2,mac3);

         end

       else if(menu=9) then
         begin
             warunek:=0;
         end

        else
            begin
              break;
            end;

    end
  else
      begin
        warunek:=0;
        writeln('Blednie wprowadzone dane');
        writeln('Prosze o ponowne wprowadzenie danych');

      end;
   until(warunek=1);

readln();

end.
edytowany 1x, ostatnio: olesio, 2012-11-11 16:29

Pozostało 580 znaków

2012-11-10 21:36
0

A debugiera to nie masz?


Wykonuję programy na zamówienie, pisać na Priv.
Asm/C/C++/Pascal/Delphi/Java/C#/PHP/JS oraz inne języki.

Pozostało 580 znaków

2012-11-10 22:20
-321oho
0

w ocenieniu składni

O poziomie twojej składni świadczy masa spacji w dziwnych i losowych miejscach. Poza tym:

 if(menu=0) then
         begin
            dodawanie(mac1,mac2,mac3);
         end

       else if(menu=1) then
         begin
             odejmowanie(mac1,mac2,mac3);
         end

       else if(menu=2) then
         begin
             mnozenie(mac1,mac2,mac3);
         end

       else if(menu=3) then
         begin
             odwrotnosc1(mac1,mac3);

         end

       else if(menu=4) then
         begin
             odwrotnosc2(mac2,mac3);

         end

       else if(menu=9) then
         begin
             warunek:=0;
         end

        else
            begin
              break;
            end;

Wygląda jak podręcznikowy przykład drabinki ifów którą należy zamienić na case.

type
  macierz1 = array [0..n, 0..n] of real;
  macierz2 = array [0..n, 0..n] of real;
  macierz3 = array [0..n, 0..n] of real;

Who cares, those aren't same. O braku typowego przedrostku z T nie mówiąc. No i rozwiązaniu typowo TurboPascalowym (tablice są po to żeby zapychać RAM) nie mówiąc.

procedure  wartosci(var m1:macierz1; var m2:macierz2);
var
  i,j:integer;

  begin
    writeln;
    writeln('Macierz pierwsza:');

      for i := 0 to w1-1 do
          begin
               for j := 0 to k1-1 do
                   begin
                    m1[i,j] := random(10);
                    write(m1[i,j],' ');
                   end;
            writeln();
          end;

    writeln;
    writeln('Macierz druga:');

      for i := 0 to w2-1 do
          begin
               for j := 0 to k2-1 do
                   begin
                    m2[i,j] := random(10);
                    write(m2[i,j],' ');
                   end;
            writeln();
          end;

  end;

Useful procedure is useful.

procedure dodawanie(m1:macierz1; m2:macierz2; var m3:macierz3);
 var
   i,j:integer;
[...]
          begin
            writeln('Na podstawie wprowadzonych danych nie da sie dodac tych macierzy.');
            writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
            read(warunek);
            writeln();
          end;

Efekty uboczne - podstawowy sposób przekazywania danych z procedur w programowaniu faraonowym.

           begin
             writeln('Na podstawie wprowadzonych danych nie da sie odjac tych macierzy.');
             writeln('Jezeli chcesz wprowadzic ponownie dane wpisz 0: ');
             read(warunek);
             writeln();
           end;

Ile razy to się powtarza w kodzie?
Generalnie to kod wygląda, jakby ktoś kto jest wyznawcą programowania faraonowego został zmuszony do używania procedur.

Nie jest ten program jeszcze optymalny ( wywala go gdy jest 0 na przekatnej)

Praca domowa na dzisiaj: co to jest optymalność programu, a co to bug.

_13th_Dragon napisał(a)

A debugiera to nie masz?

Nawet TP to ma, niestety mimo upowszechnienia internetu, ludzie wciąż nie są w stanie znaleźć informacji o tym, że ich IDE jest uposażone w narzędzie pomagające w lokalizowaniu i rozwiązywaniu problemów.

Pozostało 580 znaków

Odpowiedz
Liczba odpowiedzi na stronę

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0