|
|
 |
|
|
 |
Tablice z cwiczen 11.12
20znakow - Czw Gru 17, 2009 7:19 pm
Wstawiam swoj program - jesli cos nie dziala (poza tym, ze nie wyswietla wszystkich tablic )to piszcie
Kod: Zaznacz wszystkoprogram Table2Dim;
uses crt;
const m=2;n=4;
type tablica2wym = array [1..m,1..n] of integer;
tablica2wymOdwr = array [1..n,1..m] of integer;
var i,j,colx,coly: integer;
c,odwr,number:char;
koniec:Boolean;
t,t1,t2:tablica2wym;
todwr,t1odwr,t2odwr:tablica2wymOdwr;
procedure getTable(var t1:tablica2wym);
var i,j:integer;
begin
for i:=1 to m do
begin
writeln('dajesz ',i,'. wiersz: ');
for j:=1 to n do
begin
writeln('[',i,',',j,']:');
readln(t1[i,j]);
end;
end;
end; {end of getTable(var t1) }
procedure printTable(t1:tablica2wym);
var i,j:integer;
begin
clrscr;
Writeln;writeln;
for i:=1 to m do
begin
for j:=1 to n do
begin write(' [',t1[i,j]:6);write(']');end;
writeln;
end;
readln;
end; { end of printTable(t1:tablica2wym }
procedure printTableOdwr(t1:tablica2wymOdwr);
var i,j:integer;
begin
clrscr;
Writeln;writeln;
for i:=1 to n do
begin
for j:=1 to m do
begin write(' [',t1[i,j]:6);write(']');end;
writeln;
end;
readln;
end; { end of printTableOdwr(t1:tablica2wymOdwr }
function sumElements(t1:tablica2wym):integer;
var i,j,suma:integer;
begin
for i:=1 to m do
for j:=1 to n do
suma:=suma+t1[i,j];
sumElements:=suma;
end;
procedure addTables(t1,t2:tablica2wym; var tsum:tablica2wym);
var i,j:integer;
begin
for i:=1 to m do
for j:=1 to n do
tsum[i,j]:=t1[i,j]+t2[i,j];
Writeln('zrobione, wcisnij ENTER');
readln;
end;
procedure transponuj(var t2:tablica2wymOdwr;t1:tablica2wym);
var i,j:integer;
begin
for i:=1 to m do
for j:=1 to n do
t2[j,i]:=t1[i,j];
end;
procedure eraseDiagonal(var t:tablica2wym);
var i,min:integer;
begin
if n<=m then min:=n else min:=m;
for i:=1 to min do
t[i,i]:=0;
end;
function maxElement(t:tablica2wym):integer;
var i,j,max:integer;
begin
max:=t[1,1];
for i:=1 to m do
for j:=1 to n do
if t[i,j]>max then max:=t[i,j];
maxElement:=max;
end;
function sumDiagonal(t:tablica2wym):integer;
var i,sum,min:integer;
begin
if n<=m then min:=n else min:=m;
sum:=0;
for i:=1 to n do
sum:=sum+t[i,i];
sumDiagonal:=sum;
end;
procedure switchColumns(x,y:integer;var t:tablica2wym);
var i,j,temp:integer;
begin
if (x in [1..n]) and (y in [1..n]) then
begin
for i:=1 to m do
begin
temp:=t[i,x];
t[i,x]:=t[i,y];
t[i,y]:=temp;
end;
writeln('zrobione, wcisnij ENTER');
readln;
end
else Writeln('Podane kolumny spoza zakresu ',n,', zamiana niemozliwa.');
end;
function minimalRowSum(t:tablica2wym):integer;
var i,j,rowSum,minRowSum:integer;
begin
rowSum:=0;
for j:=1 to n do
rowSum:=rowSum+t[1,j];
minRowSum:=rowSum;
for i:=2 to m do
begin
rowSum:=0;
for j:=1 to n do
rowSum:=rowSum+t[i,j];
if rowSum<minRowSum then minRowSum:=rowSum;
end;
minimalRowSum:=minRowSum;
end;
function menuEmulation:char;
var c:char;
begin
ClrScr;
Writeln('Co chcesz zrobic?');
writeln('[0]. Wydrukowac macierz (...) ');
writeln('[1]. Wyzerowac przekatna macierzy (...) ');
writeln('[2]. Wysumowac elementy na przekatnej (...)');
writeln('[3]. Dodac 2 macierze ');
writeln('[4]. Transponowac macierz (...)');
writeln('[5]. Znalezc sume elementow macierzy (...) ');
writeln('[6]. Znalezc element maksymalny macierzy (...) ');
writeln('[7]. Znalezc najmniejsza sume po wierszach (...) ');
writeln('[8]. Zamienic kolumny w macierzy (...) ');
writeln('[9]. Zakonczyc program ');
readln(c);
menuEmulation:=c;
end;
procedure clarify(var c:char);
begin
repeat
clrscr;
writeln('Wybierz macierz : ');
writeln('[1]. macierz pierwsza. ');
writeln('[2]. macierz druga. ');
writeln('[3]. macierz sumy. ');
readln(c);
until c in ['1'..'3'];
end;
BEGIN
ClrScr;
Writeln('Podaj dane dla macierzy T1: ');
getTable(t1);
Clrscr;
Writeln('Podaj dane dla macierzy T2: ');
getTable(t2);
repeat
koniec:=false;
repeat
c:=menuEmulation
until c in ['0'..'9'];
case c of
'0': {drukowanie}
begin
odwr:=chr(0);
Writeln('Wcisnij [1] i ENTER, jesli chesz wydrukowac macierz transponowana');
Writeln('W przeciwnym razie wcisnij ENTER 2 razy');
readln(odwr);
clarify(number);
case number of
'1': if odwr = '1' then printTableOdwr(t1odwr) else printTable(t1);
'2': if odwr = '1' then printTableOdwr(t2odwr) else printTable(t2);
'3': if odwr = '1' then printTableOdwr(todwr) else printTable(t);
end;
Writeln('Wcisnij ENTER');
end;
'1': {zerowanie przekatnej}
begin
clarify(number);
case number of
'1': eraseDiagonal(t1);
'2': eraseDiagonal(t2);
'3': eraseDiagonal(t);
end;
end;
'2': {sumowanie po przekatnej}
begin
clarify(number);
Writeln('Suma elementow na przekatnej macierzy ',number,' wynosi:');
case number of
'1': Writeln(sumDiagonal(t1));
'2': Writeln(sumDiagonal(t2));
'3': Writeln(sumDiagonal(t));
end;
Writeln('Wcisnij ENTER');readln;
end;
'3': addTables(t1,t2,t); {dodawanie dwoch macierzy}
'4': {transponowanie}
begin
clarify(number);
case number of
'1': transponuj(t1odwr,t1);
'2': transponuj(t2odwr,t2);
'3': transponuj(todwr,t);
end;
end;
'5': {sumowanie elementow}
begin
clarify(number);
Writeln('Suma elementow macierzy ',number,' wynosi: ');
case number of
'1': Writeln(sumElements(t1));
'2': Writeln(sumElements(t2));
'3': Writeln(sumElements(t));
end;
Writeln('Wcisnij ENTER');readln;
end;
'6': {max element macierzy}
begin
clarify(number);
Writeln('Maksymalny element macierzy ',number,' wynosi: ');
case number of
'1': Writeln(maxElement(t1));
'2': Writeln(maxElement(t2));
'3': Writeln(maxElement(t));
end;
Writeln('Wcisnij ENTER');readln;
end;
'7': {minimalna suma po wierszach}
begin
clarify(number);
Writeln('Minimalna suma po wierszach dla macierzy ',number,' wynosi:');
case number of
'1': Writeln(minimalRowSum(t1));
'2': Writeln(minimalRowSum(t2));
'3': Writeln(minimalRowSum(t));
end;
Writeln('Wcisnij ENTER');readln;
end;
'8':
begin
clarify(number);
Writeln('Podaj numery kolumn, ktore chcesz zamienic: ');
Writeln('Kol. nr: ');Readln(colx);
Writeln('z kol. nr: ');Readln(coly);
case number of
'1': switchColumns(colx,coly,t1);
'2': switchColumns(colx,coly,t2);
'3': switchColumns(colx,coly,t);
end;
end;
'9':
begin
Writeln('Program zakonczyl dzialanie. Wcisnij ENTER');
koniec:=true;
end;
end; {end of case}
until koniec;
Readln;
END.
Olcia - Czw Gru 17, 2009 8:47 pm
Maciek?
Ja nie wątpię że to działa, ale (przynajmniej ja) w ogóle nie mam pojęcią, co jest co
Jesteś za mądry
zanotowane.pldoc.pisz.plpdf.pisz.plalbionteam.htw.pl
zanotowane.pldoc.pisz.plpdf.pisz.plcichooo.htw.pl
|
|
|
|
