Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 07.11.2019, 17:32   #1 (permalink)
Gasphord
Новичок
 
Регистрация: 15.10.2019
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Post Монотонная последовательность в квадратной матрице

Необходимо подсчитать количество строк и столбцов матрицы 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.
Gasphord вне форума   Ответить с цитированием

Старый 07.11.2019, 17:32
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Содержательные ответы вы можете найти в похожих темах

Работа с квадратной матрицей
Если максимальный элемент квадратной матрицы находится выше главной диагонали...
Паскаль. Задача о квадратной матрице.

Старый 07.11.2019, 20:29   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от Gasphord Посмотреть сообщение
Я совершенно запутался в ходе решения и не могу разобраться,помогите.
Попробую.
Только я, знаете ли, пользую классический допотопный Паскаль, безо всяких 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.
Ввод матрицы лучше сделать как у меня, с подсказками, а не "слепым", как у Вас. Вывод матрицы на экран желательно форматный, тогда столбцы не будут "разъезжаться" при разном количестве знаков в элементах матрицы. Но это так, к слову.
Миниатюры
aa01.jpg  
Vladimir_S вне форума   Ответить с цитированием
Старый 07.11.2019, 21:27   #3 (permalink)
Евгений
Member
 
Аватар для Евгений
 
Регистрация: 31.03.2010
Адрес: Тульская область
Сообщений: 1,309
Сказал(а) спасибо: 11
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 13090
По умолчанию

Код:
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.
Евгений вне форума   Ответить с цитированием
Старый 08.11.2019, 21:00   #4 (permalink)
Gasphord
Новичок
 
Регистрация: 15.10.2019
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Спасибо большое

**********************
Цитата:
Сообщение от Vladimir_S Посмотреть сообщение
Попробую.
Только я, знаете ли, пользую классический допотопный Паскаль, безо всяких 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.
Ввод матрицы лучше сделать как у меня, с подсказками, а не "слепым", как у Вас. Вывод матрицы на экран желательно форматный, тогда столбцы не будут "разъезжаться" при разном количестве знаков в элементах матрицы. Но это так, к слову.
Gasphord вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ


Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




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

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.