Технический форум

Технический форум (http://www.tehnari.ru/)
-   Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)
-   -   Монотонная последовательность в квадратной матрице (http://www.tehnari.ru/f43/t266227/)

Gasphord 07.11.2019 17:32
Монотонная последовательность в квадратной матрице
 
Необходимо подсчитать количество строк и столбцов матрицы A(n*n),элементы которых образуют монотонную последовательность (по возростанию или убыванию).Можно использовать только процедуры и функции.Я совершенно запутался в ходе решения и не могу разобраться,помогите.

Код:
Const n=3;
 
Type
  St=array [1..n]of integer;
 Ta=array[1..n] of st;
  Var i,j,Z,X:integer;
  a,b:Ta;
 
function Getmat():ta;
 var i, j:integer; a:ta;
 begin
 for i:=1 to n do
 for j:=1 to n do
  Read(a[i,j]);
 RESULT:=A;
 end;
 
 procedure Vivod(a:Ta);
  Var i,j:integer;
 begin
 for i:=1 to n do
 begin
 for j:= 1 to n do
 Write(a[i,j],' ');
 writeln;
 end;
 end;
 function MontonST(S:St):boolean;
 var i:integer;
 begin
 i:=2;
  result:=true;
  if S[1]<S[2]then
    begin
      while (i<=n-1) and result do
      if S[i]<S[i-1] then
      result:=false;
    end
  else
    begin
      while(i>n-1) and result do Z:=Z+1;
      if S[I]>S[i-1] then
      result:=false;
    end;
 end;
 function MontonSB(a:Ta;j:integer):boolean;
  Var i:integer;
    Begin
    i:=2;
    result:=true;
      begin
        while (j<=n-1) and result do X:=x+1;
        if a[i,j]<a[i,j-1] then
      result:=false
      else a[i,j]>=a[i,j-1]
      End;
    end;
 begin
 Z:=0;
 X:=0;
 B:=Getmat();
 for i := 1 to n do
 if MontonST(a[i]) then writeln(z);
 for j:=1 to n do
 if MontonSB(a,j) then writeln(x);
Vivod(b);
 read(i);
end.

Vladimir_S 07.11.2019 20:29
Вложений: 1
Цитата:
Сообщение от Gasphord (Сообщение 2669314)
Я совершенно запутался в ходе решения и не могу разобраться,помогите.
Попробую.
Только я, знаете ли, пользую классический допотопный Паскаль, безо всяких Result'ов. Так что уж не взыщите.
Я бы решал задачку так:
Код:
Const n=3;

Type
 Matr=array[1..n,1..n] of integer;
 Vect=array[1..n] of integer;

Var
 i,j,N_of_lns,N_of_col:integer;
 a:Matr;
 V:Vect;

procedure Getmat;
var i,j:integer;
begin
 for i:=1 to n do
  for j:=1 to n do
  begin
    write('a[',i:2,',',j:2,'] = ');
    readLn(a[i,j]);
  end;
  writeln;
  writeln;
end;

procedure Vivod;
var i,j:integer;
 begin
  for i:=1 to n do
  begin
    for j:= 1 to n do
    write(a[i,j]:4);
    writeln;
  end;
  writeln;
 end;

function Sign(s1,s2:integer):integer;
begin
 if s1>s2 then Sign:=1 else
 if s1<s2 then Sign:=-1 else
 Sign:=0;
end;

function Monton(S:Vect):boolean;
var
 i:integer;
 flag:boolean;
 begin
  flag:=true;
  i:=1;
  repeat
  Inc(i);
  if Sign(S[i],S[i+1])<>Sign(S[1],S[2]) then flag:=false;
  until (flag=false) or (i=n-1);
  Monton:=flag;
 end;

Begin
 GetMat;
 Vivod;
 N_of_lns:=0;
 for i:=1 to n do
  begin
  for j:=1 to n do V[j]:=a[i,j];
  if Monton(V) then Inc(N_of_lns);
  end;
 N_of_col:=0;
 for j:=1 to n do
  begin
  for i:=1 to n do V[i]:=a[i,j];
  if Monton(V) then Inc(N_of_col);
  end;
 Writeln('Number of lines  = ',N_of_lns);
 Writeln('Number of columns = ',N_of_col);
 Readln
End.
Ввод матрицы лучше сделать как у меня, с подсказками, а не "слепым", как у Вас. Вывод матрицы на экран желательно форматный, тогда столбцы не будут "разъезжаться" при разном количестве знаков в элементах матрицы. Но это так, к слову.

Евгений 07.11.2019 21:27
Код:
uses Crt;
const n=4;
type matr=array[1..n,1..n] of integer;
function Mon1(aA:matr; ai:integer):boolean;
var j:integer;
begin
    Mon1:=true;
      j:=2;
      While j<=n do
      if aA[ai,j]>aA[ai,j-1]
        then Inc(j)
        else
        begin
          Mon1:=false; Break;
        end;
    if Mon1=false
      then
      begin
        Mon1:=true;
        j:=n-1;
        While j>=1 do
          if aA[ai,j]>aA[ai,j+1]
          then Dec(j)
          else
            begin
              Mon1:=false; Break;
            end;
      end;
end;
function Mon2(aA:matr; aj:integer):boolean;
var i:integer;
begin
    Mon2:=true;
      i:=2;
      While i<=n do
      if aA[i,aj]>aA[i-1,aj]
        then Inc(i)
        else
        begin
          Mon2:=false; Break;
        end;
    if Mon2=false
      then
      begin
        Mon2:=true;
        i:=n-1;
        While i>=1 do
          if aA[i,aj]>aA[i+1,aj]
          then Dec(i)
          else
            begin
              Mon2:=false; Break;
            end;
      end;
end;
var A:matr;
    x,y,S,L:integer;
begin
  ClrScr;
  Randomize;
    for x:=1 to n do
      begin
        for y:=1 to n do
          begin
            A[x,y]:=Random(51);
            Write(A[x,y]:4);
            end;
          Writeln;
      end;
    Writeln;
  L:=0;
    for x:=1 to n do
    if Mon1(A,x) then Inc(L);
  S:=0;
    for y:=1 to n do
    if Mon2(A,y) then Inc(S);
  Writeln('Stolbcov =',S);
    Writeln('Liniy    =',L);
  Readkey;
end.

Gasphord 08.11.2019 21:00
Спасибо большое
 
**********************
Цитата:
Сообщение от Vladimir_S (Сообщение 2669329)
Попробую.
Только я, знаете ли, пользую классический допотопный Паскаль, безо всяких Result'ов. Так что уж не взыщите.
Я бы решал задачку так:
Код:
Const n=3;

Type
 Matr=array[1..n,1..n] of integer;
 Vect=array[1..n] of integer;

Var
 i,j,N_of_lns,N_of_col:integer;
 a:Matr;
 V:Vect;

procedure Getmat;
var i,j:integer;
begin
 for i:=1 to n do
  for j:=1 to n do
  begin
    write('a[',i:2,',',j:2,'] = ');
    readLn(a[i,j]);
  end;
  writeln;
  writeln;
end;

procedure Vivod;
var i,j:integer;
 begin
  for i:=1 to n do
  begin
    for j:= 1 to n do
    write(a[i,j]:4);
    writeln;
  end;
  writeln;
 end;

function Sign(s1,s2:integer):integer;
begin
 if s1>s2 then Sign:=1 else
 if s1<s2 then Sign:=-1 else
 Sign:=0;
end;

function Monton(S:Vect):boolean;
var
 i:integer;
 flag:boolean;
 begin
  flag:=true;
  i:=1;
  repeat
  Inc(i);
  if Sign(S[i],S[i+1])<>Sign(S[1],S[2]) then flag:=false;
  until (flag=false) or (i=n-1);
  Monton:=flag;
 end;

Begin
 GetMat;
 Vivod;
 N_of_lns:=0;
 for i:=1 to n do
  begin
  for j:=1 to n do V[j]:=a[i,j];
  if Monton(V) then Inc(N_of_lns);
  end;
 N_of_col:=0;
 for j:=1 to n do
  begin
  for i:=1 to n do V[i]:=a[i,j];
  if Monton(V) then Inc(N_of_col);
  end;
 Writeln('Number of lines  = ',N_of_lns);
 Writeln('Number of columns = ',N_of_col);
 Readln
End.
Ввод матрицы лучше сделать как у меня, с подсказками, а не "слепым", как у Вас. Вывод матрицы на экран желательно форматный, тогда столбцы не будут "разъезжаться" при разном количестве знаков в элементах матрицы. Но это так, к слову.


Часовой пояс GMT +4, время: 13:19.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.