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

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

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

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

Ответ
 
Опции темы
Старый 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 Кб, 21 просмотров)
Dregar55 вне форума Ответить с цитированием
Старый Вчера, 01:17   #2
canadamoscow
Пользователь
 
Аватар для canadamoscow
 
Регистрация: 16.05.2020
Сообщений: 18
По умолчанию

Вращение серединки по-часовой
Код:
begin
 var n := 7;
 var a := MatrGen(n,n, (i,j) -> 10+i*10+j);
 a.Println(3);Println;
 for var i := 0 to n div 2 do //3
  for var j := 0 to n div 2-1 do// 0
   if (i+j >= n div 2) and (i+n-j > n div 2) then
    begin
     swap(a[i,j], a[n-j-1,i]);
     swap(a[n-j-1,i],a[n-i-1,n-j-1]);
     swap(a[n-i-1,n-j-1],a[j,n-i-1])
    end;
 a.Println(3);
end.
10 11 12 13 14 15 16
20 21 22 23 24 25 26
30 31 32 33 34 35 36
40 41 42 43 44 45 46
50 51 52 53 54 55 56
60 61 62 63 64 65 66
70 71 72 73 74 75 76

10 11 12 40 14 15 16
20 21 51 41 31 25 26
30 62 52 42 32 22 36
73 63 53 43 33 23 13
50 64 54 44 34 24 56
60 61 55 45 35 65 66
70 71 72 46 74 75 76
А для вращения не белого квадрата, а только красных зон, нужно заменить 7-ю строку на:
Код:
if not ((i+j >= n div 2) and (i+n-j > n div 2)) then
10 11 12 13 14 15 16
20 21 22 23 24 25 26
30 31 32 33 34 35 36
40 41 42 43 44 45 46
50 51 52 53 54 55 56
60 61 62 63 64 65 66
70 71 72 73 74 75 76

70 60 50 13 30 20 10
71 61 22 23 24 21 11
72 31 32 33 34 35 12
40 41 42 43 44 45 46
74 51 52 53 54 55 14
75 65 62 63 64 25 15
76 66 56 73 36 26 16

Последний раз редактировалось canadamoscow; Вчера в 09:53.
canadamoscow вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 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