Форум программистов
 
О проблемах, например, с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail


Ответ
 
Опции темы
Старый 22.06.2020, 08:19   #1
Dregar55
Новичок
Джуниор
 
Регистрация: 22.06.2020
Сообщений: 1
По умолчанию Сдвиг квадратной матрицы

Код:
uses CRT;
type matrix=array[1..15,1..15] of real;
     massiv=array[1..50] of real;
var i,j,m,n:integer;
    a:matrix;
    b:massiv;
    min,max,xn,xk:real;
 
Function Y(x:real):real;
begin
  If (x<=0) then y:=sqrt(-x)
    else if ((x>=0) and (x<5)) then y:=x
      else if (x>=5) then y:=4*x*x;
end;
 
Procedure Generate(n:integer; var a:matrix);
var i,j:integer;
begin
  xk:=(xk-xn)/(N*N-1);
  for i:=1 to n do
    for j:=1 to n do
    begin
      a[i,j]:=y(xn);
      xn:=xn+xk;
    end;
end;
 
procedure minmax(i,j:shortint);
begin
if a[i,j]<min then min:=a[i,j];
if a[i,j]>max then max:=a[i,j];
end;
 
Procedure Print(n:integer; var a:matrix);
var i,j:integer;
begin
     for i:=1 to n   do begin
         for j:=1 to n do begin
         if (i=1) and (j>=i) or (j=1) and (i>=j) or (j=n) and (i<=j)
         then textcolor(14) else textcolor(7);
         minmax(i,j);
         write(a[i,j]:8:2,' ');
         end;
         textcolor(7);
         writeln(' ');
         end;
end;
 
procedure Diagonal(n:integer; var a:matrix); //замена диагоналей
var i,j:integer;
    tmp:real;
begin
  for i:=1 to n do
    for j:=1 to n do
    if i=j then
    begin
      tmp:=a[i,j];
      a[i,j]:=a[i,n-i+1];
      a[i,n-i+1]:=tmp;
    end;
end;
 
Procedure Swap(var a,b:real);
var temp:real;
begin
  temp:=a;
  a:=b;
  b:=temp;
end;
 
Procedure Move(di,dj:shortint);
begin
i:=i+di;
j:=j+dj;
m:=m+1;
b[m]:=a[i,j];
end;
 
Procedure AtoB;
begin
i:=n+1;
j:=1;
while i>1 do move(-1,0);
i:=1;
j:=1;
while j<n do move(0,1);
i:=1;
j:=n;
while i<n do move(1,0);
end;
 
Procedure PrintB;
var i:shortint;
begin
for i:=1 to m do
  begin
  textcolor(14);
  write(b[i]:8:2);
  end;
writeln('');
end;
 
Procedure Sortup;
var i,j:shortint;
begin
for j:=1 to m-1 do
 for i:=1 to m-j do
 if b[i]>b[i+1] then swap(b[i], b[i+1]);
end;
 
Procedure Sortdown;
var i,j:shortint;
begin
for j:=1 to m-1 do
 for i:=1 to m-j do
 if b[i]<b[i+1] then swap(b[i], b[i+1]);
end;
 
Procedure Rotation;
var i,j:integer;
begin
  for i:=1 to n do 
    for j:=1 to n do 
    if (i<=j) and (i<=n-j+1) then swap(a[i,j],a[n-i+1,j]);
end;
        
 
begin
clrscr;
min:=a[1,1];
max:=a[1,1];
write('Введите начальное значение Xn= ');
readln(xn);
repeat
  write('Введите конечное значение Xk= ');
  readln(xk);
  if (Xk<=Xn) then
  writeln('Xk меньше или равен Xn, повторите ввод!');
until (Xk>Xn);
repeat 
  write('Введите размерность матрицы А (От 5 до 15):');
  readln(n);
  if not ((n>=5) and (n<=15)) then
  writeln('Неверно задана размерность массива!(от 5 до 15)');
until (n>=5) and (n<=15);
writeln('Исходная матрица А, где A[i,j]=f(x) согласно условия');
writeln('y=sqrt(-x) при x<=0, y=x при 0<=x<5, y=4*x^2 при x>=5');
writeln('-------------------------------------------');
Generate(n,a);
Print(n,a);
writeln('-------------------------------------------');
textcolor(11);
writeln('Минимальное значение массива min=', min:0:2);
writeln('Максимальное значение массива max=', max:0:2);
writeln('-------------------------------------------');
textcolor(11);
writeln('-------------------------------------------');
writeln('Вывод массива B[i] после прохода по траектории');
writeln('-------------------------------------------');
AtoB;
PrintB;
textcolor(11);
writeln('-------------------------------------------');
writeln('Сортируем массив B[i] по возрастанию');
writeln('-------------------------------------------');
Sortup;
PrintB;
textcolor(11);
writeln('-------------------------------------------');
writeln('Сортируем массив B[i] по убыванию');
writeln('-------------------------------------------');
Sortdown;
PrintB;
textcolor(11);
writeln('-------------------------------------------');
writeln('Меняем значения массива в направлении,согласно задания');
writeln('-------------------------------------------');
Rotation;
Print(n,a);
readln;
end.
не могу догнать как поменять траекторию как на рисунки и указать номера строк и номера столбцов на пересечении, которых находятся
максимальный и минимальный элементы.
Изображения
Тип файла: png вектор.PNG (14.5 Кб, 9 просмотров)
Dregar55 вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Осуществить циклический сдвиг элементов квадратной матрицы(Помогите пожалуйста!!! ) Челобег Паскаль, Turbo Pascal, PascalABC.NET 2 21.05.2016 01:11
Осуществить циклический сдвиг элементов квадратной матрицы ( Паскаль ) Челобег Помощь студентам 0 03.04.2016 14:36
ЦИКЛИЧЕСКИЙ СДВИГ ЭЛЕМЕНТОВ КВАДРАТНОЙ МАТРИЦЫ kreiver Помощь студентам 6 04.03.2014 17:50
В квадратной матрице сделать циклический сдвиг стобцов влево на 1 Foxlin Помощь студентам 6 22.12.2013 13:52
C++.циклический сдвиг элементов квадратной матрицы arsalan Помощь студентам 1 11.05.2010 07:08


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS
Здесь нужно купить рекламу за 7 тыс руб в месяц! )
пишите сюда - alarforum@yandex.ru
ИКС 840