Версия для печати темы

Автор: Bush 21.11.2006 15:32

Задача на мой взгляд не простая поэтому и лбращаюсь за помощью.
Дана матрица,записанная в текстовый файл.Сдвинуть элементы заданной матрицы в пределах каждого слоя на одну позицию по часовой стрелке.Первый слой образуется из элементов находящихся по периметру матрицы,второй по периметру оставшейся подматрицы и т.д. до заполнения всей матрицы.Полученную матрицу дописать в файл.На экране расскрасить слои разными цветами.
Если есть возможность помогите пожалуйста.

Автор: volvo 21.11.2006 16:45

Что именно вызывает затруднения? Чтение матрицы из файла? Поворот по часовой стрелке? ДОзапись в файл? раскрашивание разными цветами разных "слоев"?

Не может же быть, чтобы НИЧЕГО вообще не получалось?

Автор: Bush 21.11.2006 22:25

Поворот слоев.

Автор: volvo 21.11.2006 23:25

const
  num_row = 5;
  num_col = num_row;

type
  mx = array[1 .. num_row, 1 .. num_col] of integer;

procedure print(const arr: mx);
var i, j: integer;
begin
  for i := 1 to num_row do begin

    for j := 1 to num_col do
      write(arr[i, j]:4);
    writeln;

  end;
  writeln;

end;

procedure rotate_layer(var arr: mx; const n: integer);
var
  buf: array[1 .. num_row * num_col] of integer;
  count: integer;

  function in_buffer(save: boolean; var X: integer): integer;
  begin
    inc(count);

    if save then buf[count] := X
    else X := buf[count];

    in_buffer := 1;
  end;

var
  T, i, j: integer;
  cycle: boolean;
begin
  if n > (num_row div 2) then exit;

  // Цикл будет выполнен 2 раза: сначала при cycle = true, потом при cycle = false
  // Первый проход (при cycle = true) - это запись элементов, составляющих "слой"
  // в буферный массив (in_buffer при первом параметре = true сохраняет значение).
  // На втором проходе будет выполнена обратная процедура: на те же позиции 
  // в матрицу вернется содержимое буфера.

  // А для того, чтобы не делать пустую работу (что сохранили, то и восстановить?
  // Какой смысл в этом, "слой" же надо повернуть), сам буфер "прокручивается",
  // см. комментарии ниже по тексту
  for cycle := true downto false do begin
    count := 0;
    i := n; j := n;
  
    while j <= num_col - n do inc(j, in_buffer(cycle, arr[i, j]));
    while i <= num_row - n do inc(i, in_buffer(cycle, arr[i, j]));
    while j >= n do dec(j, in_buffer(cycle, arr[i, j]));
    inc(j); dec(i);
  
    while i > n do dec(i, in_buffer(cycle, arr[i, j]));
  
    // Вот, собственно. Пришли сюда на первой итерации. Значит, массив buf
    // уже содержит все элементы, которые в матрице составляют "слой".
    // Прокручиваем его, т.е., запоминаем последний, сдвигаем все остальные
    // на одну позицию вправо, и возвращаем бывшие последним элемент в первую
    // позицию. Если теперь вернуть элементы ТОЧНО В ТОМ ЖЕ ПОРЯДКЕ, как их
    // записывали в buf, назад в матрицу, то "слой" окажется повернутым по часовой
    // стрелке. Чтобы повернуть ПРОТИВ часовой - надо прокрутить buf в обратном
    // направлении: сдвинуть все элементы на 1 левее, а первый перенести в конец.
    T := buf[count];
    move(buf[1], buf[2], (count - 1)*sizeof(integer));
    buf[1] := T;
  end;

end;

const
  A: mx = (
    (1, 2, 3, 4, 5),
    (3, 4, 5, 6, 7),
    (7, 8, 9, 0, 2),
    (2, 7, 4, 9, 1),
    (0, 3, 7, 7, 5)
  );

begin
  print(A);
  rotate_layer(A, 2);
  print(A);
end.

Автор: Bush 22.11.2006 22:28

Вроде ясно.Спасибо.

Автор: Merhaba 19.04.2011 0:46

Цитата(volvo @ 21.11.2006 13:45)

Автор: volvo 19.04.2011 1:00

Добавил немного комментариев. Так понятнее?

Автор: Merhaba 19.04.2011 1:08

Цитата(volvo @ 18.04.2011 22:00)

Автор: Lapp 19.04.2011 6:40

Цитата(Merhaba @ 18.04.2011 22:08)

  if n<m then k:= n else k:= m;
  k:= k div 2;              {это количество слоев}
  while k>0 do begin        {цикл с уменьшением числа слоев дает нужный сдвиг каждого слоя}
    for i:=1 to k do begin  {цикл по слоям, от внешнего к внутреннему}
      b:= a[i,i];                {сохраняем левый верхний элемент}
      for j:=i to n-i do a[j,i]:= a[j+1,i]; {поэлементно двигаем левую сторону слоя вверх на одну позицию}
      for j:=i to m-i do a[n-i+1,j]:= a[n-i+1,j+1];   {двигаем нижнюю сторону влево}
      for j:=n-i downto i do a[j+1,m-i+1]:= a[j,m-i+1];   {двигаем правую сторону вниз}
      for j:=m-i downto i+1 do a[i,j+1]:= a[i,j]; {двигаем верхнюю сторону вправо кроме последнего элемента}
      a[i,i+1]:= b   {кладем сохраненный элемент во вторую позицию верхней стороны слоя}
    end;
    Dec(k)     {уменьшаем количество сдвигаемых слоев}
  end;

Автор: Merhaba 19.04.2011 9:47

Цитата(Lapp @ 19.04.2011 3:40)

  if n<m then k:= n else k:= m;
  k:= k div 2;              {это количество слоев}
  while k>0 do begin        {цикл с уменьшением числа слоев дает нужный сдвиг каждого слоя}
    for i:=1 to k do begin  {цикл по слоям, от внешнего к внутреннему}
      b:= a[i,i];                {сохраняем левый верхний элемент}
      for j:=i to n-i do a[j,i]:= a[j+1,i]; {поэлементно двигаем левую сторону слоя вверх на одну позицию}
      for j:=i to m-i do a[n-i+1,j]:= a[n-i+1,j+1];   {двигаем нижнюю сторону влево}
      for j:=n-i downto i do a[j+1,m-i+1]:= a[j,m-i+1];   {двигаем правую сторону вниз}
      for j:=m-i downto i+1 do a[i,j+1]:= a[i,j]; {двигаем верхнюю сторону вправо кроме последнего элемента}
      a[i,i+1]:= b   {кладем сохраненный элемент во вторую позицию верхней стороны слоя}
    end;
    Dec(k)     {уменьшаем количество сдвигаемых слоев}
  end;

Автор: Lapp 19.04.2011 9:54

Цитата(Merhaba @ 19.04.2011 6:47)

Автор: Merhaba 21.04.2011 0:31

Цитата(Lapp @ 19.04.2011 6:54)

Автор: Lapp 21.04.2011 14:25

Цитата(Merhaba @ 20.04.2011 21:31)

k := k-1;

k-= 1;

Автор: -TarasBer- 21.04.2011 17:42

> Это, конечно, сильно увеличит время выполнения, но это общий закон: либо память - либо время.

В данном случае это не так.

Для того, чтобы сделать циклический сдвиг массива из m элементов на n, надо НОД(m,n) раз сделать такую операцию: взять k-ый элемент (k - это номер операции, то есть мы делаем это сначала для k=0, потом для k=1, и так далее до k=НОД(m,n)-1) и поменять его местами с k+n-ым. Потом k+n-ый поменять с k+n+n b так далее, пока не окажется, что новый элемент, с которым надо менять, имеет индекс k. Вообще в цепочке длины L надо выполнить L-1 обмен. Кстати, L = m / НОД(m,n)

Короче, если грузануть хитрую алгебру, то можно без затрат обойтись без доп.массива.

Автор: Lapp 22.04.2011 3:27

Цитата(-TarasBer- @ 21.04.2011 14:42)

Автор: Merhaba 22.04.2011 13:10

Цитата(Lapp @ 21.04.2011 11:25)

k := k-1;

k-= 1;

b:= a[i,i]; 

Автор: TarasBer 22.04.2011 13:12

Ну, в данном случае это извращение довольно просто реализуется.
А вот для случая обмена a и 2*a подобное провернуть не удастся (если помнишь ту старую тему), так как задача сводится к задаче дискретного логарифмирования, а она за время разумного порядка не решается. (Это используется в криптографии, кстати).
А слово это не я придумал. Это вроде с какого-то сайтика с развитой системой рейтинга (и вытекающими из неё последствиями) пошло.

Автор: Lapp 22.04.2011 15:04

Цитата(Merhaba @ 22.04.2011 10:10)

b:= a[i,i]; 

const
  n= 6;
  m= 7;

var
  a: array [1..n,1..m] of integer;
  i,j,k,l,b: integer;

begin
  {заполняем}
  for i:=1 to n do for j:=1 to m do a[i,j]:= (i-1)*m+j;
  WriteLn('before:');
  for i:=1 to n do begin
    for j:=1 to m do Write(a[i,j]:3);
    WriteLn
  end;

  {двигаем}
  if n<m then k:= n else k:= m;
  k:= k div 2;              {это количество слоев}
  while k>0 do begin        {цикл с уменьшением числа слоев дает нужный сдвиг каждого слоя}
    for i:=1 to k do begin  {цикл по слоям, от внешнего к внутреннему}
      b:= a[i,i];                {сохраняем левый верхний элемент}
      for j:=i to n-i do a[j,i]:= a[j+1,i]; {поэлементно двигаем левую сторону слоя вверх на одну позицию}
      for j:=i to m-i do a[n-i+1,j]:= a[n-i+1,j+1];   {двигаем нижнюю сторону влево}
      for j:=n-i downto i do a[j+1,m-i+1]:= a[j,m-i+1];   {двигаем правую сторону вниз}
      for j:=m-i downto i+1 do a[i,j+1]:= a[i,j]; {двигаем верхнюю сторону вправо кроме последнего элемента}
      a[i,i+1]:= b   {кладем сохраненный элемент во вторую позицию верхней стороны слоя}
    end;
    Dec(k)
  end;

  {выводим}
  WriteLn('after:');
  for i:=1 to n do begin
    for j:=1 to m do Write(a[i,j]:3);
    WriteLn
  end;
  ReadLn
end.