*(Вопрос) Я делаю различныее варианты кластерного анализа и желаю сравнить некоторые решения с помощью каппы Коэна. * Проблема в том, что я должен каждый раз перекодировать одну из категориальных переменных таким образом, чтобы она максимизировала перекрытие с другой переменной перед тем, как подсчитать каппу. Число категорий переменных может быть от 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.