Форум программистов, компьютерный форум, киберфорум
canadamoscow
Войти
Регистрация
Восстановить пароль
Карта форума Блоги Сообщество Поиск Заказать работу  
Рейтинг: 4.00. Голосов: 1.

Матрица NxM по спирали

Запись от canadamoscow размещена 22.07.2021 в 17:33

Pascal
1
2
3
4
5
6
7
8
9
10
11
##
var (n,m) := (5,4);
var a := new integer[n,m];
var (i,j, c, ii,jj) := (0,0, 1, 0,1); 
repeat  
  a[i,j] := c;
  if not((i+ii in 0..n-1) and (j+jj in 0..m-1) and (a[i+ii, j+jj] = 0)) then 
     (ii,jj):= ii=0? (jj,0):(0,-ii); //поворот направо
  (i,j,c) := (i+ii,j+jj,c+1);
until c > n*m;
a.Println
Pascal
1
2
3
4
5
6
7
8
9
10
##
var (n, m) := (4, 6);
var a := new integer[n, m];
var (i, j, c, d) := (0, -1, 1, 1);
repeat
  loop m do begin j += d; a[i, j] := c; c += 1 end;
  loop n - 1 do begin i += d; a[i, j] := c; c += 1 end;
  (d, m, n) := (-d, m - 1, n - 1)
until (n = 0) or (m = 0);
a.Println
Pascal
1
2
3
4
5
6
7
8
9
10
11
##
var (n,m) := (3,6);
var a := new integer[n,m];
for var i := 0 to n-1 do
  for var j := 0 to m-1 do begin
     var x := min(i,j,n-1 - i, m-1 - j);
     a[i,j] := n*m+1 - if (i>x) and (m-1-j>x) then
       (n-2*x-2)*(m-2*x-2) + (i-x) + (j-x) 
     else (n-2*x)*(m-2*x) - (i-x) - (j-x)
  end;
a.Println
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
//В квадратной матрице закрученной по спирали определить индекс указанного значения
##
var (tt,n) := (1,5); //треубуемое значение, размер матрицы
var t := n*n+1-tt; //программа заточента для расчета при спирали из центра
var q := 1+ord(n.IsEven); 
while q*q < t do q+=2; //сторона (колво элементов) нужного квадрата
var coner := (q*q+(q-2)*(q-2)) div 2; //значение в правом нижнем углу квадрата
var i := n div 2 + (q-1) div 2;//индекс этого значения в углу
var j := i;
if t<coner then (i,j) := if t > coner-q then (i,j+t-coner) else (i+t-coner+q-1,n-1-j)
else (i,j) := if t < coner+q then (i-t+coner,j) else (n-1-i,j-t+coner+q-1);
$'{tt} = {(i,j)}'.Println
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
##
var n := 6;
MatrGen(n, n, (i, j) -> begin var x := min(i, j, n-1 - i, n-1 - j); Result := n*n+1 -
if i>j then (n-2*x-2)*(n-2*x-2)+(i-x)+(j-x) else (n-2*x)*(n-2*x)-(i-x)-(j-x) end).Print;
 
//Поиск индекса элемента со значением value в квадратной матрице NxN
var value := ReadlnInteger('Введите значение:');
var k := trunc((n - sqrt(n*n+1 - value)) / 2); //номер квадрата в котором value: 0-внешний и далее
var quarter := n-2*k-1; //четверть длины квадрата k (сторона квадрата на 1 больше: quarter+1)
var corner := n*n+1 - (quarter+1)*(quarter+1); //значение в левом верхнем углу квадрата k
case (value-corner) div quarter of //в какой четверти квадрата находится value
  0: Print((k, k+value-corner));//сверху
  1: Print((k+value-corner-quarter, n-1 - k));//справа
  2: Print((n-1 - k, k+corner+3*quarter-value));//снизу
  3: Print((k+corner+4*quarter-value, k));//слева
end
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
//Поиск индекса элемента со значением valueX в матрице NxМ
##
var (n,m,valueX) := (6,3,4);
MatrGen(n,m,(i,j) ->begin var x:= min(i,j,n-1-i,m-1-j); Result := n*m+1 - 
if (i>x) and (m-1-j>x) then (n-2*x-2)*(m-2*x-2) + (i-x) + (j-x) 
else (n-2*x)*(m-2*x) - (i-x) - (j-x) end).Println;
 
var value := n*m+1-valueX;
var k := trunc((n+m - sqrt((n+m)*(n+m) - 4*(n*m-value))) / 4);
var corner1 := (n-2*k)*(m-2*k);
var corner2 := corner1 - (m-1-2*k);
var corner3 := corner2 - (n-1 -2*k);
var corner4 := corner3 - (m-1-2*k);
var i,j: integer;
if value > corner3 then
  (i,j) := value>corner2 ? (k, k+corner1-value) : (k+corner2-value,m-1-k)
else (i,j) := value>corner4 ? (n-1-k, k+value-corner4) : (n-1-k-corner4+value,k);
Print(valueX,(i,j))
Размещено в Без категории
Показов 2476 Комментарии 1
Всего комментариев 1
Комментарии
  1. Старый комментарий
    Аватар для canadamoscow
    Pascal
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    
    ##
    var (n,m) := (5,6);
    var a := new integer[n,m];
    var (i,j,ii,jj,k) := (0,0,0,1,0); 
    for var c := 1 to n*m do begin
      a[i,j] := c;
      if (ii=-1) and (i-1=k) then k+=1; //переход в след.спираль
      if k<>min(i+ii,j+jj,n-1-i-ii,m-1-j-jj) then //выход зв спираль?
         (ii,jj):= ii=0? (jj,0):(0,-ii); //поворот направо
      (i,j) := (i+ii,j+jj);
    end;
    a.Println
    Запись от canadamoscow размещена 25.07.2021 в 15:05 canadamoscow вне форума
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru