заполнение массива (pascal)

[Inferi]

Любопытство не дает покоя - который день пытаюсь решить задачку (просто интересно как это работает) и не выходит. А задача на заполнение массива элементами по определенной траектории. Скажем, мне нужно в порядке убывания разместить элементы в направлении, указанном на рисунке:
Безымянный.JPG

код что-то не получается: до центра дохожу и стопорится, да к тому же зацикливается (только и успевай тормозить выполнение). Использую циклы while и if.
Кто-нибудь знает верное решение? Подскажите/помогите

[baster128]

Братишка! Совершенно недавно сталкнулся с аналогичной проблемой. Если собираешься решать ее через двухмерный массив, то бестолку. МАтрица может быть или прямоугольной или треугольной. При попытке создать нарисованную тобой, я потерял половину значений. Лезет ошибка AcssesViolation, то есть обращение к элементу массива которого нет.

[RUSt88]

в 2 цикла решается эта задача

могу выполнить за вознаграждение

[Inferi]

baster128
Сестренка, если что

RUSt88
платно утолять любопытство не хочется) но за предложение спасибо!

Думала общими усилиями отыскать ответ. В интернете решения этой задачи нет.
Конечно, зарабатывать людям (вроде Вас, RUSt88) тоже надо, не спорю. Ну может все таки найдутся волонтеры, вроде меня

[Grag]

Есть алгоритмы заполнения матрицы "змейкой", вот их и используй, слегка модифицировав... Утоли свои желания!!!

[Stilet]

Тебе, сестренка, нужно что-то в этом роде:

const n=10;
var a:array[1..n,1..n] of integer;
 i,j:integer;
begin
   for i:=1 to (n div 2) do begin
    for j:=i+1 to n-i do begin
     a[j,i]:=j;
     a[j,n-i+1]:=j;
    end;
   end;

   for i:=1 to n do begin
    for j:=1 to n do begin
     write(a[i,j]:5);
    end;writeln;
   end;
  { TODO -oUser -cConsole Main : Insert code here }
  readln;
end.

[Inferi]

Сообщение от Grag

Есть алгоритмы заполнения матрицы "змейкой", вот их и используй, слегка модифицировав... Утоли свои желания!!!

Так с этого все и начиналось!) Нашла пример заполнения "змейкой" (только на угол..) - от него и начала лепить. И получилось нечто странное, зацикленное). А поскольку в паскале не сильна, то и прошу помощи.

Stilet Тебе, сестренка, нужно что-то в этом роде:

Я, кажется, перемудрила (дело, наверное, в примере, от которого начала дело). Был у меня вариант решения с for, только что-то не пошел в дело.
У меня получилось следующее:

var
  n, i, j, st, kl, k, max, min: integer; a: array [1..10, 1..10] of integer;

begin
  {clrscr;}
  write('ukajite razmernost matrici do 10 :'); readln(n);
  st := 1; kl := n; k := 1;
  a[st, kl] := k;
  min := 1; {ВЕРХНЯЯ ГРАНИЦЫ}
  max := n;  {НИЖНЯЯ ГР}
  
  while k<n*n do begin
   // (min <> n) and (max <> 1) do  begin
//не входит в цикл 3   
    if (kl = max) and (st > min) then begin
      st:=st-1; k:=k+1; a[st,kl]:=k;
        while (st < max) do begin st:=st+1; k:=k+1; a[st,kl]:=k;end;
      kl:=kl-1;
    end
// цикл 2
    else if (kl > min) and (st = max) then begin
      st:=st-1; k:=k+1; a[st,kl]:=k;
        while (st > min) do begin st:=st-1; k:=k+1; a[st,kl]:=k; end;
      kl:=kl-1;
      max:=max-1;
 //     min:=min-1;
    end
//цикл 1   
    else if (kl > min) and (st = min) then begin
      st:=st+1; k:=k+1; a[st,kl]:=k;
        while (st < max)do begin st:=st+1; k:=k+1; a[st,kl]:=k;end;
      kl:=kl-1;
 //     max:=max-1;
      min:=min+1;
     end
// не входит в цикл 4
     else if (kl = min) and (st > min) then begin
      st:=st-1; k:=k+1; a[st,kl]:=k;
        while (st > min) do begin st:=st-1; k:=k+1; a[st,kl]:=k; end;
      kl:=kl-1;
      min:=min+1;
    end;  
    
  writeln('vivod resultata');
  for i := 1 to n do begin for j := 1 to n do write(a[i, j]:4); writeln; end;
end;
end.

Предупреждаю: успевайте остановить, если запустите. Он же зациклен)

[Stilet]

Я, кажется, перемудрила

Не обижайся, даже разбираться не стал, у больно мудрено написано. Мы люди простые, деревенские, нам ченить попроще нравится делать...
Если тебе подходит мой пример - бери не стесняйся

[Inferi]

Сообщение от Stilet

Не обижайся, даже разбираться не стал, у больно мудрено написано. Мы люди простые, деревенские, нам ченить попроще нравится делать...
Если тебе подходит мой пример - бери не стесняйся

Спасибо за пример. Несовсем то, что требовалось, но теперь буду "мудрить", опираясь на него

[megachuhancer]

Если я правильно понял условие задачи, то...

Я рачертил различные варианты траектории в зависимости от размеров квадратной матрицы у себя в тетрадке. Сперва меня заинтересовала зависимость количества элементов на траектории от размеров матрицы.
Там получаются такие числа:
1 4 7 12 17 24 31 40 49
Если посмотреть на разницу между соседними числами, то получим:
3 3 5 5 7 7 9 9
Это мне надо было, чтоб сразу числа пихать в массив по возрастанию или по убыванию, но... Мне было лень выводить формулу, а потом ещё и доказывать её(Хотя это не обязательно, лишь бы работало. Тут вроде математическая индукция, хотя я не уверен. Или наверное лучше будет с суммами помутить). Поэтому я предпочёл чисто техническое "грязное" решение - в цикле посчитать это число на основе того, что я выше установил.

Теперь как построить траекторию? Слышали когда-нибудь про "барьер"? Смотрите, наша траектория всегда меняется только одним из четырёх возможных способов. Если мы пометим все клетки, в которые наша траектория попасть не может мы получим гораздо более простую картину, типа(o - клетка траектории, x - барьер):
oxxxxxo
ooxxxoo
oooxooo
ooooooo
oooxooo
ooxxxoo
oxxxxxo
Короче, почертите на куске бумаги, посмотрите.
Забить такой барьер в массив попроще будет.
Вот что у меня получилось. Писал правда на Delphi. Не знаю как другие компиляторы переварят константы из программы. Ещё, я писал в компактном стиле, но надеюсь, в данном случае это не ухудшит понятность кода. Можно поиграться с константой n, а можно заменить её вводом. Просто с константой удобнее отлаживать было. И ещё раз понадеюсь, что правильно понял условие задачи.

program Project3;
{$APPTYPE CONSOLE}
const
  n = 10;
  BARRIER = 'X';
  dx: array [0 .. 3] of Integer = (0, -1, 0, -1);
  dy: array [0 .. 3] of Integer = (1, -1, -1, 1);
var
  a: array [1..n, 1..n] of Integer;
  //отдельный массив для барьера
  //чтобы не портить массив с числами
  c: array [0..n+1, 0..n+1] of Char;
  i, j: Integer;
  x, y: Integer;
  k, dk, l: Integer;
  direction: Integer;
begin
  //это чтобы не вылететь за пределы
  for i := 0 to n + 1 do for j := 0 to n + 1 do c[i, j] := 'X';
  for i := 1 to n do for j := 1 to n do c[i, j] := #0;
  //забиваем барьер
  for i := 1 to n div 2 do for j := i + 1 to n - i do begin
    c[i, j] := BARRIER; //верхняя половинка
    c[n - i + 1, j] := BARRIER; //нижняя половинка
  end;
  //найдём кол-во элементов на траектории, это будет самое большое
  //число из тех, что мы забьём в матрицу
  k := 1;
  dk := 3;
  for i := 2 to n do begin
    if (i > 2) and (i mod 2 = 0) then Inc(dk, 2);
    Inc(k, dk);
  end;
  //строим траекторию
  direction := 0;
  x := n; y := 1; l:= 1;
  while (x <> n div 2) or (y <> n div 2) do begin
    if c[y + dy[direction], x + dx[direction]] <> BARRIER then begin
      a[y, x] := k;
      //левая половинка траектории - отражение
      //правой, за исключением чисел
      a[n - y + 1, n - x + 1] := l;
      Dec(k); Inc(l);
      Inc(x, dx[direction]); Inc(y, dy[direction]);
      //совсем красиво не получилось, т.к. мы рискуем
      //"пробить" барьер на крутых поворотах)))
      if direction = 1 then direction := 2;
      if direction = 3 then direction := 0;
      Continue;
    end;
    //если мы попали в эту часть кода, значит, уткнулись в барьер
    //пора изменить направление
    Inc(direction);
  end;
  //выводим
  for i := 1 to n do  begin for j := 1 to n do write(a[i, j]:2, ' '); Writeln; end;
  ReadLn;
end.