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
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.