Максимизация следа матрицы

*(Вопрос) Я делаю различныее варианты кластерного анализа и желаю сравнить некоторые решения
	с помощью каппы Коэна.

* Проблема в том, что я должен каждый раз перекодировать одну из категориальных переменных
	таким образом, чтобы она максимизировала перекрытие с другой переменной
	перед тем, как подсчитать каппу. Число категорий переменных может быть от 2 до 7, но
	все переменные будут иметь одно и то же число категорий.

* Например, вот, что я получаю псле выполнения команды Crosstabs:
	      A1       A2       A3
	B1    5        5        55
	B2    25       5        10
	B3    5        30       10
	А вот, что мне нужно:
	      A1       A2      A3
	B1    25       5       10
	B2    5        30      10
	B3    5        5       55.

*(Ответ) 
* Решение - максимизация следа матрицы путём смены порядка строк.
* Будет работать на всех квадратных матрицах, размерности 7 и менее.
* Проверка матриц 8*8 потребует тестирования 40,320 диагоналей;
	макрос потребует по 1 переменной на каждую диагональ, но в SPSS число переменных
	ограничено 32,000 (в ранних версиях SPSS - А.Б.), и алгоритм придётся в этом случае видоизменить. 
* Автор: Raynald Levesque, rlevesque@videotron.ca, размещено в SPSSX-L 26.02.2002.

*//////////////.
DEFINE !mxtrace(nb=!TOKENS(1))
PRESERVE.

!IF (!nb>'5') !THEN 
SET PRINTBACK=none. 
!IFEND
SET MITERATE=1000000.
/* Часть 1: Find all permutations */

/* Во-первых, создаём файл, содержащий все перестановки (с возвращениями) */.

INPUT PROGRAM.
!DO !cnt=1 !TO !nb
LOOP !CONCAT('cnt',!cnt) =1 TO !nb.
LEAVE !CONCAT('cnt',!cnt).
!DOEND
END CASE.
!DO !cnt=1 !TO !nb.
END LOOP.
!DOEND
END FILE.
END INPUT PROGRAM.

* Считаем, какие числа повторяются более, чем 1 раз.

NUMERIC c1 TO !CONCAT('c',!nb).
!DO !cnt=1 !TO !nb
COUNT !CONCAT('c',!cnt) =cnt1 TO !CONCAT('cnt',!nb,'(',!cnt,')').
!DOEND

/* Сохраняем только настоящие перестановки (без возвращений) */.

EXECUTE.
SELECT IF MAX(c1 TO !CONCAT('c',!nb))=1.

* Считаем число перестановок и формируем макрос, принимающий это значение *.

COMPUTE nobreak=1.
RANK VARIABLES=c1 BY nobreak /N INTO npermut.
DO IF $CASENUM=1.
WRITE OUTFILE 'c:\\temp\\define npermut.sps' 
	/"DEFINE !npermut()"npermut"!ENDDEFINE.".
END IF.


STRING newname(A8).
COMPUTE newname=CONCAT('p',LTRIM(STRING($CASENUM,F8.0))).
FLIP cnt1 TO !CONCAT('cnt',!nb) /NEWNAMES=newname.
COMPUTE casen=$CASENUM.


SAVE OUTFILE='c:\\temp\\all permutations.sav' /DROP=case_lbl.

GET FILE='c:\\temp\\original data.sav'.
COMPUTE casen=$CASENUM.
MATCH FILES FILE=* /FILE='c:\\temp\\all permutations.sav' /BY=casen.
SAVE OUTFILE='c:\\temp\\data and all permutations.sav' /DROP casen.
INCLUDE 'c:\\temp\\define npermut.sps'.
!part2 nb=!nb.
!ENDDEFINE.

***************.
* Часть 2: Определяем перестановку, максимизирующую след матрицы *.
***************.


DEFINE !part2(nb=!TOKENS(1))
!LET !trlast=!CONCAT('tr',!nb)
NUMERIC tr1 TO !trlast.

* Для каждой перестановки *.

!DO !idx = 1 !TO !EVAL(!npermut)
COMPUTE permut=!idx.
SORT CASES BY !CONCAT('p',!idx).

* Получаем и сохраняем диагональ для данной перестановки *.

!DO !casenum = 1 !TO !nb
COMPUTE !CONCAT('tr',!casenum)=0.
IF $CASENUM=!casenum !CONCAT('tr',!casenum)=!CONCAT('a',!casenum).
!DOEND

!LET !filen=!QUOTE(!CONCAT('c:\\temp\\temp',!idx,'.sav'))
SAVE OUTFILE=!filen /KEEP=permut tr1 TO !trlast.
!DOEND

/* сливаем все диагонали */

GET FILE='c:\\temp\\temp1.sav'.
!DO !idx = 2 !TO !EVAL(!npermut)
ADD FILES /FILE=* /FILE=!QUOTE(!CONCAT('c:\\temp\\temp',!idx,'.sav')).
!DOEND

/* Файл сохраяем для проверки работы кода */.

SAVE OUTFILE='c:\\temp\\all diagonals.sav'. /* все диагонали */

/* Рассчитываем сумму элементов каждой диагонали (след) */.

AGGREGATE
  /OUTFILE=*
  /BREAK=permut
  /tr1 TO !trlast = SUM(tr1 TO !trlast).
COMPUTE tr=SUM(tr1 TO !trlast).

/* Находим перестановку с наибольшим следом */.

SORT CASES BY tr(D).  
N OF CASES 1.
FORMATS permut (F8.0).

* Первое наблюдение содержит номер перестановки с наибольшим значением следа.

WRITE OUTFILE='c:\\temp\\best permut.sps' /'DEFINE !bestp()'permut'!ENDDEFINE.'.
EXECUTE.
INCLUDE 'c:\\temp\\best permut.sps'. /* Лучшая перестановка */
!part3 nb=!nb.
!ENDDEFINE.
*///////////////////////.

DEFINE !part3(nb=!TOKENS(1))
GET FILE='c:\\temp\\data and all permutations.sav'. /* Данные и все перестановки */
SORT CASES BY !CONCAT('p',!EVAL(!bestp)).
MATCH FILES FILE=* /KEEP=a1 TO !CONCAT('a',!nb).

* Удаляем временные файлы *.

!DO !idx = 1 !TO !EVAL(!npermut)
!LET !filen=!QUOTE(!CONCAT('c:\\temp\\temp',!idx,'.sav'))
ERASE FILE=!filen.
!DOEND
RESTORE.
!ENDDEFINE.
*//////////////.



* Внимание:
	Макрос предполагает, что исходный файл данных называется "original data.sav" 
	и расположен в c:\\temp\\.
* Параметр nb - размерность квадратной матрицы (можно доработать код, чтобы вычислялся автоматически).

************.
*ПРИМЕР 1.
************.

DATA LIST LIST /a1 a2 a3.
BEGIN DATA
5   5  55 
25  5  10 
5   30 10 
END DATA.
LIST.


SAVE OUTFILE='c:\\temp\\original data.sav'.
SET MPRINT=yes.
!mxtrace nb=3.
EXECUTE.

************.
*ПРИМЕР 2.
************.
DATA LIST LIST /a1 a2 a3 a4.
BEGIN DATA
5  5  55 7
25 5  10 20
5  30 10 15
18 32 25 18
END DATA.
LIST.


SAVE OUTFILE='c:\\temp\\original data.sav'.

!mxtrace nb=4.
EXECUTE.

************.
*ПРИМЕР 3.
************.
DATA LIST LIST /a1 a2 a3 a4 a5.
BEGIN DATA
5  5  55 7  15
25 5  10 20 26
5  30 10 15 16
18 32 25 18 26 
15 16 17 18 19
END DATA.
LIST.


SAVE OUTFILE='c:\\temp\\original data.sav'.

!mxtrace nb=5.
EXECUTE.

************.
*ПРИМЕР 4.
************.
DATA LIST LIST /a1 a2 a3 a4 a5 a6.
BEGIN DATA
5  5  55 7  15 19 
25 5  10 20 26 26
5  30 10 15 16 32
18 32 25 18 26 12 
15 16 17 18 19 23
12 65 23 15 14 2
END DATA.
LIST.


SAVE OUTFILE='c:\\temp\\original data.sav'.

!mxtrace nb=6.
EXECUTE.