Понедельничная задачка ;)

← →
MBo © (2006-03-20 09:40) [0]

Дана двумерная матрица целых чисел размером MxN, записанная в одномерном массиве. Разработать процедуру транспонирования матрицы в том же массиве (inplace) без использования дополнительных массивов.
прототип:
procedure TransposeArr(var A: array of Integer; Rows, Cols: Integer);

P.S.
Трaнcпонирование матрицы A (MxN) переводит ее в матрицу B (NxM), в которой элементы B[y,x] = A[x,y]. Для квадратной - это отражение относительно главной диагонали
Пример:
00 01 02
10 11 12
будет лежать в одномерном массиве 00 01 02 10 11 12
после транспозиции
00 10
01 11
02 12

← →
palva © (2006-03-20 10:00) [1]

Транспонирование это некоторая перестановка одномерного массива. Любая перестановка разлагается на циклы: цикл это кольцевая последовательность элементов массива, каждый элемент которой при перестановке переходит в следующий. Цикл нетрудно подвергнуть перестановке, (т.е. переместить каждый элемент в следующий) без дополнительных массивов. Если бы удалось разработать алгоритм, который по числам M и N последовательно порождает по одному представителю каждого цикла (его место i, j) то задача была бы решена.

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

← →
wal © (2006-03-20 10:47) [2]

А можно без перестановок, а просто "перевычислением" ниужного индекса?

← →
McSimm © (2006-03-20 11:58) [3]

Сделал ! :))

http://www.delphimaster.ru/transpose.php
Все по условию, только перестановки внутри одномерного массива, никаких встроенных функций, кроме вывода

← →
McSimm © (2006-03-20 12:00) [4]

поспешил, не работает для произвольных M N
:(

← →
Думкин © (2006-03-20 12:02) [5]

> McSimm © (20.03.06 11:58) [3]

M(1..9): <input type="text" name="m" value="5"><br> N(1..9): <input type="text" name="n" value="4"><br> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 , 11 , 12 , 13 , 14 , 15 , 16 , 17 , 18 , 19 , 20 1 6 11 16 2 3 4 17 12 7 5 18 8 13 9 19 10 14 15 20 1 , 6 , 11 , 16 , 2 , 3 , 4 , 17 , 12 , 7 , 5 , 18 , 8 , 13 , 9 , 19 , 10 , 14 , 15 , 20

Вроде - не то.

← →
TStas © (2006-03-20 12:06) [6]

А чего сложного-то? Функция, переводящая двуменый индекс в одмометный. Дальше надо писать?

← →
McSimm © (2006-03-20 12:08) [7]

> TStas © (20.03.06 12:06) [6]

Да, именно то что дальше и надо :)

← →
TStas © (2006-03-20 12:15) [8]

А дальше ОДНА переменная, а не массив. ТРанспонируем индексы двумерные, получаем новый одномерный. То, что стояло в массиве под этим индексом пишем в переменную, ну, короче, меняем местами. Вот и все. И так всю матрицу. НЕ обязательно транспонировать и не обязательно двумерный даже. ЧУдес не бывает. Все, что в компе раположено в памяти, т. е. Array[Cardinal] of byte И деревья и вообще все.

← →
TStas © (2006-03-20 12:20) [9]

Я это все написал на бумажке, когда по городу мотался. Хотел прогу написать, но бросил.

← →
MBo © (2006-03-20 12:31) [10]

>wal © (20.03.06 10:47) [2]
>А можно без перестановок, а просто "перевычислением" ниужного индекса?
Ну так неинтересно ;)

>McSimm
при 3х3 - неверный результат

>TStas
Дан именно одномерный массив. Но и для двумерного неквадратного не совсем тривиально произвести транспонирование на месте.

Могу дать простенькую заготовку, использованную мной для тестирования:

procedure TForm4.Button1Click(Sender: TObject); procedure ShowAsMatr(Arr: array of Integer; Rows, Cols: Integer); var x, y: Integer; s: string; begin Memo1.Lines.Add(""); for y := 0 to Rows - 1 do begin s := ""; for x := 0 to Cols - 1 do s := s + Format("%.4d ", [Arr[y * Cols + x]]); Memo1.Lines.Add(s); end; end; procedure FillMatr(var Arr: array of Integer; Rows, Cols: Integer); var x, y: Integer; begin for y := 0 to Rows - 1 do for x := 0 to Cols - 1 do Arr[y * Cols + x] := y * 100 + x; end; procedure TransposeArr(var A: array of Integer; Rows, Cols: Integer); begin // ????????????????????? end; const H = 4; W = 5; var Arr: array of Integer; begin SetLength(Arr, W * H); FillMatr(Arr, H, W); ShowAsMatr(Arr, H, W); TransposeArr(Arr, H, W); ShowAsMatr(Arr, W, H); end;

← →
McSimm © (2006-03-20 12:31) [11]

> TStas ©

ну, короче, все ясно :)

← →
Jeer © (2006-03-20 12:38) [12]

srcc.msu.su :))

← →
McSimm © (2006-03-20 12:44) [13]

Мда, задумка у меня была красивая, но раьотает только при N<3 :))))
Жаль времени нет. Но я ее добью потом

← →
han_malign © (2006-03-20 13:07) [14]

> без использования дополнительных массивов.

- а временная перепенная, под хранение элемента - считается частным случаем дополнительного массиав с размером 1???

← →
MBo © (2006-03-20 13:16) [15]

>han_malign © (20.03.06 13:07) [14]
Несколько переменных можно использовать.

Формально - допускается использование O(1) памяти, но не O(N)

← →
palva © (2006-03-20 13:58) [16]

Могу привести пример с использованием дополнительного бита. То есть под целые элементы матрицы разрешается использовать 31 бит. Это не разрешается условием но обозначает проблему. Константы m и n можно задать произвольными целыми положительными.
{$APPTYPE CONSOLE} const m = 3; n = 4; var a0: array[1..m*n] of Integer; a1: array[1..m, 1..n] of Integer absolute a0; i, j, k: Integer; procedure TransposeArr(var A:array of Integer; Rows, Cols: Integer); var n, i, j, k, s, s_new, temp: Integer; begin n := Rows*Cols; for k := 0 to n - 1 do A[k] := A[k] Shl 1; for k := 0 to n - 1 do begin if not odd(A[k]) then begin temp := A[k]; s := k; repeat j := s mod Cols; i := s div Cols; s_new := j*Rows+i; if s_new<>k then begin A[s] := A[s_new] Or 1; s := s_new end else begin a[s] := temp Or 1; break end until false end end; for k := 0 to n - 1 do A[k] := A[k] Shr 1; end; begin for k :=1 to n*m do a0[k] := k; for i := 1 to m do begin for j := 1 to n do Write(a1[i, j]:5); WriteLn end; TransposeArr(a0, m, n); Writeln; for i := 1 to m do begin for j := 1 to n do Write(a1[i, j]:5); WriteLn end end.

← →
palva © (2006-03-20 16:24) [17]

Что-то я не совсем то сделал.

← →
MBo © (2006-03-20 16:32) [18]

>palva © (20.03.06 16:24) [17]
>Что-то я не совсем то сделал.

Да вроде бы верно, только Cols и Rows наоборот, как в фортране

← →
palva © (2006-03-20 16:45) [19]

Да. Вот так надо
{$APPTYPE CONSOLE} const m = 12; n = 5; var a0: array[1..m*n] of Integer; a1: array[1..m, 1..n] of Integer absolute a0; a2: array[1..n, 1..m] of Integer absolute a0; i, j, k: Integer; procedure TransposeArr(var A:array of Integer; Rows, Cols: Integer); var n, i, j, k, s, s_new, temp: Integer; begin n := Rows*Cols; for k := 0 to n - 1 do A[k] := A[k] Shl 1; for k := 0 to n - 1 do begin if not odd(A[k]) then begin temp := A[k]; s := k; repeat j := s mod Rows; i := s div Rows; s_new := j*Cols+i; if s_new<>k then begin A[s] := A[s_new] Or 1; s := s_new end else begin a[s] := temp Or 1; break end until false end end; for k := 0 to n - 1 do A[k] := A[k] Shr 1; end; begin for k :=1 to n*m do a0[k] := k; for i := 1 to m do begin for j := 1 to n do Write(a1[i, j]:5); WriteLn end; TransposeArr(a0, m, n); Writeln; for i := 1 to n do begin for j := 1 to m do Write(a2[i, j]:5); WriteLn end end.
Google по "rectangular matrix transpose inplace" дает ссылки на ACM, но там сами статьи можно читать после платной регистрации. Может быть, и есть какие-то теорчисловые исследования на эту тему.

← →
Jeer © (2006-03-20 17:12) [20]

palva © (20.03.06 16:45) [19]

Еще раз:
Не самый лучший вариант, но - идея понятна дб., тем более, что двухвариантна - Fortran & C

http://www.srcc.msu.su/num_anal/lib_na/cat/cat522.htm

← →
McSimm © (2006-03-20 17:23) [21]

Я ее все-таки сделал !
http://www.delphimaster.ru/transpose.php?m=4&n=3

← →
McSimm © (2006-03-20 17:30) [22]

Ну, нет у меня Delphi, что поделать :)
Может и не совсем оптимально, но мне нравится, красиво.

Борис, спасибо за задачку :) !

function get_index($i, $j, $m) { return $i*$m+$j; } function transpose(&$a, $m, $n) { for ($i=0; $i<$n; $i++) { for ($j=0; $j<$m; $j++) { $k1 = get_index($i, $j, $m); $k2 = get_index($k1 % $n, (int)($k1 / $n), $m); while ($k1 > $k2) $k2 = get_index($k2 % $n, (int)($k2/$n), $m); if ($k1 != $k2) { $c = $a[$k1]; $a[$k1] = $a[$k2]; $a[$k2] = $c; } } } }

>palva
Судя по обсуждению:
http://groups.google.ru/group/fido7.ru.algorithms/browse_thread/thread/3dad00d1e4052377/b41999effedc054a?q=%D1%82%D1%80%D0%B0%D0%BD%D1%81%D0%BF%D0%BE%D0%BD%D0%B8%D1%80%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D0%B8&rnum=2#b41999effedc054a
хорош по скорости метод с использованием O(N) дополнительной памяти для отметки пройденных элементов и отдельной обработкой квадратной части,
http://www.srcc.msu.su/num_anal/lib_na/cat/am/amtgr.htm

В принципе, для меня задача практического значения не имеет, но при её решении мне было полезно то, что я осознал общность метода для класса задач перестановок в массиве. Родственная задачка была как-то на переупорядочение сортированного массива "горкой", т.е. получение битонической последовательности. Тогда помучиться пришлось, зато теперь легче ;) Я не сохранял признак обработанности, поэтому в начале цикла проверка по цепочкам пробегает. Возможно, введение счетчика обработанных узлов ускорит процесс, но для простоты я его убрал. Изменяя ReverseIndex, можно хоть крутить матрицу, хоть еще что-то делать:

procedure TransposeArr(var A: array of Integer; Rows, Cols: Integer); var iStart, iForward, iTemp, Total, aStored: Integer; function ReverseIndex(indx: Integer): Integer; begin Result := (indx mod Rows) * Cols + indx div Rows; end; begin Total := Rows * Cols; iStart := 0; while iStart < Total do begin iForward := ReverseIndex(iStart); while iForward > iStart do iForward := ReverseIndex(iForward); if iForward >= iStart then begin iTemp := iStart; aStored := a[iStart]; iForward := ReverseIndex(iTemp); while iForward <> iStart do begin a[iTemp] := a[iForward]; iTemp := iForward; iForward := ReverseIndex(iTemp); end; a[iTemp] := aStored; end; Inc(iStart); end; end;

>Ну, нет у меня Delphi
Ну общий смысл понятен , только от $$ в глазах рябит ;))

> ReverseIndex(iTemp);

SubTotal:= Rows * Cols - 1; .......... ReverseIndex:= (Cols * iTemp) mod SubTotal;
- должно быть быстрее...
(имеет строгое доказательство)

>- должно быть быстрее...
Ну можно и divmod использовать или ассемблерное деление, но это не так существенно.

Из любопытства ради сравнения быстродействия на скорую руку перевел фортрановский исходник AMTGR из БЧА НИВЦ (с ошибками, но на сравнение это не влияет).
Примерное отношение времен выполнения
AMTGR: Palva: MBo

Маленькие матрицы(m,n~10):
1: 1: 2

Большие (m,n~100-300) почти квадратные:
1: 1.5: 5

Большие вытянутые m/n=3:
1: 3: 20

Большие сильно вытянутые m/n=10:
1: 1.5: 9

Впечатляет:)

классная задачка :)
полголовы уже сломал, зашел в тупик, ищу выход.
пытаюсь сделать чтобы цикл был не больше чем Rows * Cols - 2

> Danilka © (21.03.06 15:03) [29]

хм... без дополнительного массива флаговых данных ?
у меня работал такой алгоритм, но сбивался при увеличении матрицы

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

[30] McSimm © (21.03.06 15:21)
> хм... без дополнительного массива флаговых данных ?
> у меня работал такой алгоритм, но сбивался при увеличении
> матрицы

Ага, у меня тоже сбивается, вот хочу рассчитать, чтоб не сбивался. :)

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

Думаю, это не совсем честно. :)

> Думаю, это не совсем честно. :)

а мы тихонько, никто не узнает :)))

не уверен, что получилось бы, но на самом деле было бы интересно попробовать.

Понедельничная задачка ;) Найти похожие ветки