Wiele działań na tablicy

Wiele działań na tablicy

Program: wykonujący wiele działań na tablicy.

Użytkowni generuje tablicę, wybierając na początku ilość kolumn + wierszy. W kolejnym kroku tworzy tablicę wpisując po kolei wartości. Po utworzeniu możliwe są działania:

  • suma liczb dodatnich,
  • suma liczb z głównej przekątnej,
  • suma liczb z nad przekątnej,
  • suma liczb odwróconej przekątnej,
  • znalezienie wartości minimalnej + jej współrzędne.

Dodatkowo sumuje wybrany przez użytkownika wiersz i kolumnę.

Kompilator: Turbo Pascal

Galeria:

Program w akcji.

Kod programu:

program tablica2wymiarowa;
uses crt;
var t:array[1..6,1..4] of integer;
    w,k:integer;

{............................. CZYTAJ ..........................................}
    PROCEDURE czytaj;
    var a,b,i:integer;
       begin
       a:=1;
       b:=1;
       for i:=1 to w do
       begin
       writeln('podaj element [',a,',',b,'] :');
       read(t[a,b]);
       repeat
       b:=b+1;
       writeln('podaj element [',a,',',b,'] :');
       read(t[a,b]);
       until b=k;
       b:=1;
       a:=a+1;
       end;
       end;

{............................ WYPISZ .....................................}

       PROCEDURE wypisz;
       var a,b,i,x,y:integer;

       begin
       clrscr;
       a:=1;
       b:=1;
       y:=1;
       for i:=1 to w do
       begin
       x:=1;
       y:=y+1;
       gotoxy(x,y);
       write('[',t[a,b],']','   ');
       repeat
       b:=b+1;
       x:=x+10;
       gotoxy(x,y);
       write('[',t[a,b],']');
       until b=k;
       b:=1;
       a:=a+1;
       end;
       end;

{............................ SUMA >0 ................................}

       PROCEDURE suma;
       var a,b,i,s:integer;
       begin
       a:=1;
       b:=1;
       s:=0;
       for i:=1 to w do
       begin
       if t[a,b]>0 then s:=s+t[a,b];
       repeat
       b:=b+1;
       if t[a,b]>0 then s:=s+t[a,b];
       until b=k;
       b:=1;
       a:=a+1;
       end;
       writeln;
       writeln;
       writeln('Suma liczb dodatnich wynosi: ',s);
       end;

{........................ SUM PRZEK ........................................}

       PROCEDURE sumaprzek;
       var a,b,i,s:integer;
       begin
       a:=1;
       b:=1;
       s:=0;
           for i:=1 to w do
           begin
           if a=b then s:=s+t[a,b];

              repeat
              b:=b+1;
              if a=b then s:=s+t[a,b];
              until b=k;

           b:=1;
           a:=a+1;
           end;
           writeln;
       writeln;
       writeln('Suma liczb z glownej przekĄtnej wynosi: ',s);
       end;

{........................ SUM nadPRZEK ....................................}

PROCEDURE sumaNADprzek;
       var a,b,i,s:integer;
       begin
       a:=1;
       b:=1;
       s:=0;
           for i:=1 to w do
           begin
           if a<b then s:=s+t[a,b];

              repeat
              b:=b+1;
              if a<b then s:=s+t[a,b];
              until b=k;

           b:=1;
           a:=a+1;
           end;
       writeln;
       writeln;
       writeln('Suma liczb z nad przekĄtnej wynosi: ',s);
       end;

{........................ SUM odrPRZEK ....................................}

PROCEDURE sumaodrprzek;
       var a,b,i,s:integer;
       begin
       a:=1;
       b:=1;
       s:=0;
           for i:=1 to w do
           begin
           if a+b=6 then s:=s+t[a,b];

              repeat
              b:=b+1;
              if a+b=6 then s:=s+t[a,b];
              until b=k;

           b:=1;
           a:=a+1;
           end;
       writeln;
       writeln;
       writeln('Suma liczb odwroconej przekĄtnej wynosi: ',s);
       end;

{........................ najmniejsza ....................................}

PROCEDURE najmniejsza;
    var a,b,i,s,x,y:integer;
      begin
       a:=1;
       b:=1;
       s:=9999;
           for i:=1 to w do
           begin
                        if t[a,b]<s then
                        begin
                        s:=t[a,b];
                        x:=a;
                        y:=b;
                        end;
              repeat
              b:=b+1;
                     if t[a,b]<s then
                     begin
                     s:=t[a,b];
                     x:=a;
                     y:=b;
                     end;
              until b=k;

           b:=1;
           a:=a+1;
           end;
       writeln;
       writeln;
       writeln('Najmniejsza liczba to: ',s);
       writeln('znajduje sie w wierszu nr: ',x);
       writeln('i kolumnie nr: ',y);
       end;
{.............................. suma wierszy .............................}

      PROCEDURE sumaw;
       var a,b,i,s,wiersz:integer;
       begin
       repeat
       write('Podaj wiersz ktory chcesz zsumowac: ');
       read(wiersz);
       if (wiersz>w) or (wiersz<=0) then writeln('Wiersz nie istnieje ! (FAIL)');
       until wiersz<=w;
       a:=1;
       b:=1;
       s:=0;
       for i:=1 to w do
       begin
       s:=s+t[wiersz,b];
       b:=b+1;
       end;
       writeln('Suma wiersza ',wiersz, ' wynosi: ',s);
       end;

{.............................. suma kolumn .............................}

      PROCEDURE sumak;
       var a,b,i,s,kol:integer;
       begin
       repeat
       write('Podaj wiersz ktory chcesz zsumowac: ');
       read(kol);
       if (kol>k) or (kol<=0) then writeln('Kolumna nie istnieje ! (FAIL)');
       until kol<=k;
       a:=1;
       b:=1;
       s:=0;
       for i:=1 to k do
       begin
       s:=s+t[a,kol];
       a:=a+1;
       end;
       writeln('Suma kolumny ',kol, ' wynosi: ',s);
       end;

{......................... o.O ....................................}

begin
clrscr;
write('podaj liczbe wierszy: ');
read(w);
write('podaj liczbe kolumn: ');
read(k);
clrscr;
czytaj;
wypisz;
suma;
sumaprzek;
sumanadprzek;
sumaodrprzek;
najmniejsza;
sumaw;
sumak;
readkey;
end.