Дьявольские магические квадраты из простых чисел

[Nataly-Mak]

(Оффтоп)

Замечательные у меня коллеги!
Carlos Rivera опубликовал на главной странице своего сайта объявление о моём новом конкурсе. Это счастливо совпало с опубликованием моей новой головоломки "Associative magic cubes of prime numbers"
http://www.primepuzzles.net/

[whitefox]

Nataly-Mak в сообщении #912558 писал(а):

Следовательно, гипотеза ваша опровергнута? Найти четвёрку точных попарно ортогональных покрытий ещё не значит - иметь готовый пандиагональный квадрат.
Другими словами, существование такой четвёрки условие необходимое, но не достаточное для построения пандиагонального квадрата.

Да, это так.

Nataly-Mak в сообщении #912558 писал(а):

Кстати, я думаю, что достаточно проверить один из трёх способов объединения покрытий в пары. В свете моего преобразования "строки-диагонали" (мы раньше выяснили, что это преобразование есть и у Россера, только он его так, как я, не называл).

В пандиагональном квадрате выделяются строки, столбцы, прямые диагонали и обратные диагонали. Строки и столбцы обзовём термином "ряды", а прямые и обратные диагонали – термином "диагонали". Как показал Россер, строки и столбцы можно поменять местами, также можно поменять местами прямые и обратные диагонали, кроме того, при нечётном порядке, можно менять местами ряды и диагонали. Но, например, не возможно поменять местами столбцы и прямые диагонали не заменяя при этом строки обратными диагоналями. Поэтому и нужно проверять максимум три способа объединения точных покрытий в пары.

Nataly-Mak в сообщении #912558 писал(а):

Так, с полумагическими квадратами всё понятно. На первом этапе алгоритма проверки пытаемся превратить полумагический квадрат в магический. Если этот этап завершается успешно, мы имеем уже магический квадрат.

Верно. С маленьким добавлением, первый этап состоит из двух подэтапов. Сначала ищется "почти магический" квадрат (только с одной магической диагональю), а затем уже пытаемся превратить его в магический.

Nataly-Mak в сообщении #912558 писал(а):

Кстати, вчера пыталась посчитать, сколько же этих изоморфов для квадратов 7-го порядка. Вы говорите, что их 8. В книге Чебракова написано, что М-преобразований для квадратов 7-го порядка 24.

Книги Чебракова у меня нет, поэтому не могу сказать, что именно он подсчитывает. А формула для подсчета числа М-преобразований следующая $2^kk!$, где $k=\left\lfloor\frac n2\right\rfloor$, а $n$ – порядок квадрата. В частности, для $n=7$ эта формула даёт $2^33!=48$ М-преобразований. Но в нашем случае можно оставлять неподвижными элементы в углах квадрата поэтому их число сокращается до $2^22!=8$

[Nataly-Mak]

whitefox в сообщении #912582 писал(а):

Книги Чебракова у меня нет, поэтому не могу сказать, что именно он подсчитывает. А формула для подсчета числа М-преобразований следующая $2^kk!$, где $k=\left\lfloor\frac n2\right\rfloor$, а $n$ – порядок квадрата. В частности, для $n=7$ эта формула даёт $2^33!=48$ М-преобразований. Но в нашем случае можно оставлять неподвижными элементы в углах квадрата поэтому их число сокращается до $2^22!=8$

Тогда посмотрите мою книгу там это воспроизводится.
Кстати, в книге Чебракова описываются М-преобразования двух видов.
Итак, у вас 48 М-преобразований для квадратов 7-го порядка, в книге Чебракова их 24.
Кто-то обманывает

[whitefox]

Скорее всего здесь дело в терминологии. Например, центральную симметрию я считаю М-преобразованием, а Чебраков, видимо, нет.

[Nataly-Mak]

whitefox в сообщении #912582 писал(а):

Nataly-Mak в сообщении #912558 писал(а):

Кстати, я думаю, что достаточно проверить один из трёх способов объединения покрытий в пары. В свете моего преобразования "строки-диагонали" (мы раньше выяснили, что это преобразование есть и у Россера, только он его так, как я, не называл).

В пандиагональном квадрате выделяются строки, столбцы, прямые диагонали и обратные диагонали. Строки и столбцы обзовём термином "ряды", а прямые и обратные диагонали – термином "диагонали". Как показал Россер, строки и столбцы можно поменять местами, также можно поменять местами прямые и обратные диагонали, кроме того, при нечётном порядке, можно менять местами ряды и диагонали. Но, например, не возможно поменять местами столбцы и прямые диагонали не заменяя при этом строки обратными диагоналями. Поэтому и нужно проверять максимум три способа объединения точных покрытий в пары.

Итак, я утверждаю (гипотетически), что для четвёрки точных попарно ортогональных покрытий масссива из 49 чисел (то есть для квадрата 7-го порядка) все покрытия равноправны и без разницы, как их объединить в строки/столбцы/диагонали.
Могу ошибаться. Докажите, что я ошибаюсь.

Вот мы проверяли выше одну такую четвёрку. Проверили первый вариант из трёх, результат - пандиагонального квадрата не существует с таким объединением покрытий в строки/столбцы/диагонали. Я говорю: всё, дальше можно не проверять, никакой другой расклад не даст пандиагонального квадрата. А вы говорите, что надо обязательно проверить три варианта расклада строки/столбцы/диагонали.
Тогда с вас пример такой четвёрки, в которой для одного варианта расклада пандиагональный квадрат не существует, а для другого варианта расклада существует.

В приведённом выше примере пандиагональный квадрат не существует ни для одного расклада, хотя я два других расклада и не проверяла, но уже утверждаю, что не существует - по результату проверки только одного варианта расклада.

-- Сб сен 27, 2014 09:35:11 --

whitefox в сообщении #912588 писал(а):

Скорее всего здесь дело в терминологии. Например, центральную симметрию я считаю М-преобразованием, а Чебраков, видимо, нет.

Что вы имеете в виду под центральной симметрией?

-- Сб сен 27, 2014 09:47:07 --

Цитата:

Но, например, не возможно поменять местами столбцы и прямые диагонали не заменяя при этом строки обратными диагоналями.

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

[whitefox]

Nataly-Mak в сообщении #912595 писал(а):

Итак, я утверждаю (гипотетически), что для четвёрки точных попарно ортогональных покрытий масссива из 49 чисел (то есть для квадрата 7-го порядка) все покрытия равноправны и без разницы, как их объединить в строки/столбцы/диагонали.
Могу ошибаться. Докажите, что я ошибаюсь.

Возьмите любой пандиагональный квадрат. Выпишите точные покрытия ему соответствующие. Поменяйте местами строки и прямые диагонали, а столбцы и обратные диагонали оставьте старые. Из полученных точных покрытий попробуйте составить пандиагональный квадрат.

Nataly-Mak в сообщении #912595 писал(а):

Что вы имеете в виду под центральной симметрией?

Квадрат

1 2 3
4 5 6
7 8 9

при центральной симметрии переходит в

9 8 7
6 5 4
3 2 1

что эквивалентно повороту на $180^\circ$

Поэтому важно не число М-преобразований (которое зависит от определения), а общее число автоморфизмов магического квадрата. Для квадрата порядка $n$ я их насчитываю $2^{k+2}k!$, где $k=\left\lfloor\frac n2\right\rfloor$. То есть при $n=7$ число автоморфизмов будет 192, а как у Чебракова?

[Nataly-Mak]

whitefox в сообщении #912603 писал(а):

Возьмите любой пандиагональный квадрат. Выпишите точные покрытия ему соответствующие. Поменяйте местами строки и прямые диагонали, а столбцы и обратные диагонали оставьте старые. Из полученных точных покрытий попробуйте составить пандиагональный квадрат.

Это я и собираюсь сделать.

Цитата:

Квадрат

1 2 3
4 5 6
7 8 9

при центральной симметрии переходит в

9 8 7
6 5 4
3 2 1

что эквивалентно повороту на $180^\circ$

А, ну так это одно из основных преоброзований магического квадрата.
Конечно, Чебраков это преобразование не относит к М-преобразованиям.

Цитата:

Поэтому важно не число М-преобразований (которое зависит от определения), а общее числа автоморфизмов магического квадрата. Для квадрата порядка $n$ я их насчитываю $2^{k+2}k!$, где $k=\left\lfloor\frac n2\right\rfloor$. То есть при $n=7$ число автоморфизмов будет 192, а как у Чебракова?

Я сечас не помню, есть ли у Чебракова подсчёт всех автоморфизмов магического квадрата.
Речь шла конкретно о М-преобразованиях, которые есть перестановки строк и столбцов (одновременно!). Именно эти преобразования интересны нам с точки зрения возможности превращения магического квадрата в пандиагональный.

-- Сб сен 27, 2014 10:40:52 --

whitefox в сообщении #912603 писал(а):

Возьмите любой пандиагональный квадрат. Выпишите точные покрытия ему соответствующие. Поменяйте местами строки и прямые диагонали, а столбцы и обратные диагонали оставьте старые. Из полученных точных покрытий попробуйте составить пандиагональный квадрат.

Так, уточняю, что с чем нельзя поменять местами?
Выше вы писали:

Цитата:

Но, например, не возможно поменять местами столбцы и прямые диагонали не заменяя при этом строки обратными диагоналями.

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

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

[whitefox]

Nataly-Mak в сообщении #912607 писал(а):

Или нельзя и то, что в первой цитате, и то что во второй цитате?

Нельзя один вид "рядов" (строки либо столбцы) заменять одним видом "диагоналей" (прямыми либо обратными), оставляя второй вид "рядов" (и второй вид "диагоналей") без изменения.

Nataly-Mak в сообщении #912607 писал(а):

Неизвестно ещё, какие диагонали вы называете прямыми, а какие обратными. Возможно, совсем не так, как называю я.

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

[Nataly-Mak]

Ага, спасибо, теперь поняла. Ушла менять местами

[Nataly-Mak]

whitefox
да, вы правы: пандиагональный квадрат при таком раскладе не составился.

[Nataly-Mak]

whitefox
как я поняла, вы хорошо проштудировали статью Россера.
Скажите, пожалуйста, нет ли в этой статье такого свойства пандиагональных квадратов 8-го порядка:
магическая константа любого пандиагонального квадрата 8-го порядка кратна 4

У меня это свойство основано пока только на экспериментальных данных.
Может быть, это свойство следует из каких-то других свойств пандиагональных квадратов 8-го порядка, отмеченных в статье Россера?

[Nataly-Mak]

Решила донести до иностранцев замечательный алгоритм svb для пандиагональных квадратов 6-го порядка, точнее: свойство пандиагональных квадратов 6-го порядка, которое я сформулировала в виде теоремы (теорема Сергея Беляева).
Думаю, что и для читателей этой темы теорема будет полезна. Это теорема об отклонениях от комплементарности в пандиагональном квадрате 6-го порядка.
Приведу пост на английском языке, как на форуме у ice00 запостила.

Denote pandiagonal square of order 6 as follows:

a1 a2 a3 b1 b2 b3
a4 a5 a6 b4 b5 b6
a7 a8 a9 b7 b8 b9
b1’ b2’ b3’ a1’ a2’ a3’
b4’ b5’ b6’ a4’ a5’ a6’
b7’ b8’ b9’ a7’ a8’ a9’

Let the magic constant of this square is $S$.
Denote: $q = S/3$.

Theorem (author S. Belyaev)

ai + ai’ – q = pi
bi + bi’ – q = -pi

($i = 1, 2, 3, …, 9$)

where

p1 + p5 + p9 = 0
p3 + p5 + p7 = 0
p1 – p6 – p8 = 0
p9 – p2 – p4 = 0
p3 – p4 – p8 = 0
p7 – p2 – p6 = 0

so that the square:

p1 p2 p3 -p1 -p2 -p3
p4 p5 p6 -p4 -p5 -p6
p7 p8 p9 -p7 -p8 -p9
-p1 -p2 -p3 p1 p2 p3
-p4 -p5 -p6 p4 p5 p6
-p7 -p8 -p9 p7 p8 p9

is pandiagonal square with magic constant $S=0$.

Example

67 193 71 251 109 239
139 233 113 181 157 107
241 97 191 89 163 149
73 167 131 229 151 179
199 103 227 101 127 173
211 137 197 79 223 83

We have in this pandiagonal square:

$S = 930$, $q = 310$

p1 = -14
p2 = 34
p3 = -60
p4 = -70
p5 = 50
p6 = -24
p7 = 10
p8 = 10
p9 = -36

More see here
http://www.natalimak1.narod.ru/pannetr1.htm

[whitefox]

Nataly-Mak в сообщении #913028 писал(а):

как я поняла, вы хорошо проштудировали статью Россера.
Скажите, пожалуйста, нет ли в этой статье такого свойства пандиагональных квадратов 8-го порядка:
магическая константа любого пандиагонального квадрата 8-го порядка кратна 4

Напротив, в статье Россера меня заинтересовала только построенная им группа автоморфизмов пандиагонального квадрата, на остальное не было времени. Поэтому ответа на ваш вопрос я не знаю, увы

[Nataly-Mak]

К эпохальному решению maxal - наименьшему пандиагональному квадрату 4-го порядка из последовательных простых чисел - я могу пока добавить наименьший пандиагональный квадрат 8-го порядка из последовательных простых чисел, содержащий 4 ошибки - это 4 повторенных элемента:

79  101  439  109  227  401  379  281 
359  233  263  409  191  197  251  113 
89  419  257  271  269  383  149  179 
389  311  173  131  229  83  353  347 
283  97  167  181  431  397  107  353* 
307  313  211  433  139  277  199  137 
193  163  349  331  373  127  241  239 
317  379*  157  151  157*  151*  337  367 

$S=2016$

Плохие (повторенные) элементы помечены *

Это результат двухмесячной работы. Моё первое приближение к решению содержало 14 ошибок, причём даже не все элементы были простыми числами.
Вот такой прогресс. Но настоящее решение ещё очень далеко, если оно вообще существует.
Программу крутила долго, приближений с 4 дырками найдено несколько; меньше 4 дырок пока не имеется.
В последней программе реализован самый совершенный из известных мне алгоритмов построения нетрадиционного пандиагонального квадрата 8-го порядка.
Алгоритм описан в моей статье.

-- Ср дек 03, 2014 10:17:24 --

Процитирую письмо Jarek:

Цитата:

Ja dumaju, czto najti kwadrat 8x8 s priedpolozenym naborom czisel prakticzeski niewozmozno. Pomnitie, czo dla kwadrata 7x7 eto bylo oczen oczen slozno, dla kwadrata 8x8 eto jeszczio sloznieje. No 11 dyrok eto sowsiem mnogo - mnie kazetsja, czto eto mozno umienszit (no nie k nuliu).

Интересное мнение.
Я писала ему в тот момент, когда было найдено приближение с 11 дырками.
Его прогноз о том, что количество дырок можно уменьшить, блестяще подтвердился, в чём я и не сомневалась.
Но вот можно ли свести количество дырок к нулю

-- Ср дек 03, 2014 10:24:01 --

Эх, настолько сильно сидит в голове квадрат 8-го порядка, что о квадрате 7-го порядка уже и забыла

Вот он - наименьший пандиагональный квадрат 7-го порядка из последовательных простых чисел, но... тоже с 4 дырками:

151 139 227 181 13 79 7
43 11 73 157 49* 253* 211
167 137 97 193 23 31 149
107 109 131 113 199 97* 41
173 101 59 17 197 71 179
53 239 127 89 233 37 19
103 61 83* 47 83 229 191

$S=797$

Давно бросила этот квадрат (не получается хорошее решение без дырок ) и перешла к квадрату 8-го порядка.

[Nataly-Mak]

Nataly-Mak в сообщении #911762 писал(а):

Для квадратов порядка $n=6$

Программы коллег хороши, но... они не годятся для проверки большого количества потенциальных магических констант. Здесь ведь как надо: генерируем некоторый массив простых чисел, ищем в нём все годные массивы из 36 последовательных простых чисел и сразу же проверяем каждый годный массив на предмет построения пандиагонального квадрата 6-го порядка. Такой конвейер должен работать.

Я вот по одной константе уже проверила до константы 264918, но очень нудно
А решение, похоже, где-то далеко-далеко...

Уже проверила до магической константы $S=943056$.

Потенциальный массив из 36 последовательных простых чисел, дающий эту магическую константу:

157007  157013  157019  157037  157049  157051  157057  157061  157081  157103  157109  157127  157133  157141  157163  157177  157181  157189  157207  157211  157217  157219  157229  157231  157243  157247  157253  157259  157271  157273  157277  157279  157291  157303  157307  157321 

и в номализованном виде:

0  6  12  30  42  44  50  54  74  96  102  120  126  134  156  170  174  182  200  204  210  212  222  224  236  240  246  252  264  266  270  272  284  296  300  314 

Проверять по одной константе - адский труд!
Модифицировать программу коллеги не могут или... не хотят.
К одному из авторов программ - svb - обращалась с этой просьбой.
Вот что он ответил (цитирую с разрешения автора):

Цитата:

...я попытался и не смог...
Хотя моя программа и не относится к разряду трудных. Те программисты, с которыми вы общаетесь на форуме, достаточно высокого уровня. Скорее они не будут заниматься моей "примитивной" программой, сказав для "отмазки", что они не пишут на Паскале. Но есть еще студенты, им будет полезно.

Да, исходник программы есть, автор программы есть, а модифицированной программы нет

А это цитата из моего письма svb:

Цитата:

Да и чего там разбираться? Просто найти, где программа берёт массив для проверки, где вычисляет по этому массиву магическую константу. И вот этот кусок немного изменить.
Ведь в сам алгоритм проверки не надо вникать, я же его не прошу модифицировать, он отлично работает.

К автору второй программы - alexBlack - не обращалась с просьбой в ЛС.

Итак, есть ещё одна программа для модификации. Желающие имеются?
Исходник программы пришлю, он у меня есть. Он есть и на сайте автора. Программа svb написана на Паскале.

На сайте alexBlack тоже выложена программа, но не помню, есть ли исходник. Сссылку я давала выше.
Программа alexBlack написана на Delphi.
Здесь всё точно так же: программа берёт на проверку только один потенциальный массив.

Отмечу, кстати, что программа svb работает намного быстрее программы alexBlack. Так что, модифицировать желательно программу svb.
Конечно, alexBlack мог бы модифицировать свою программу с оптимизацией, чтобы она работала быстрее. Мог бы... при желании...

К сожалению, у меня все программы поиска пандиагонального квадрата 6-го порядка пропали, когда сдох старый компьютер. Так и придётся писать новую программу. А что же остаётся делать? Проверять по одной константе зверски устала

-- Вт дек 09, 2014 22:50:34 --

Чтобы не искать, выкладываю исходный код программы svb:

(Оффтоп)

{31.04.2011  ‘.‚. ЃҐ«пҐў
  Џа®Ја ¬¬  ЈҐ­Ґа жЁЁ Ї ­¤Ё Ј®­ «м­ле ¬ ЈЁзҐбЄЁе Єў ¤а в®ў Ї®ап¤Є  6.
  Џ®«­л© ЇҐаҐЎ®а.}

{$I-}
uses crt,dos;

const nmax=500;
      svb='<SVB> 05.05.2011';
      filt:byte=1;

type tpnum=array[0..2] of byte;
     tmask=array[1..2] of integer;

var p:array[1..nmax] of longint;
    m:array[1..nmax] of byte;
    S,Sc,S32,pmin,pmax:longint;
    p1,p2,p3,p4,p5,p6,p7,p8,p9,inf,pinf:longint;
    pnum:^tpnum;
    mask:^tmask;
    lnum,i,nn,nn0,xm,cp,Nq:integer;
    oname,iname:string;
    c:longint;
    ti:longint;
    stop:boolean;
    f:text;

function string6(x,i:integer):integer;forward;
procedure analiz4(x:byte);forward;

function key:char;
begin
  if keypressed then key:=readkey
  else key:=#0;
end;

procedure time(x:byte);
var h,m,s,s100:word;
    r:real;
begin
  gettime(h,m,s,s100);
  if x=0 then ti:=s100+(s+m*60+h*longint(3600))*100 else begin
    append(f);
    r:=(s100+(s+m*60+h*longint(3600))*100-ti)/100;
    writeln(f,'Time: ',r:0:2,' sec');
    writeln('Time: ',r:0:2,' sec');
    close(f);
  end;
end;

procedure sort(l,r:integer);
var  i,j,k:integer;x,y:longint;bx,by:byte;
begin
     k:=(l+r) div 2;x:=p[k];bx:=m[k];
     i:=l;j:=r;
     repeat
       while (m[i]<bx)or((m[i]=bx)and(p[i]>x)) do i:=i+1;
       while (bx<m[j])or((m[j]=bx)and(x>p[j])) do j:=j-1;
       if i<=j then begin
         y:=p[i];p[i]:=p[j];p[j]:=y;
         by:=m[i];m[i]:=m[j];m[j]:=by;
         i:=i+1;
         j:=j-1;
       end;
     until i>j;
     if (l<j) then sort(l,j);
     if (i<r) then sort(i,r);
end;

procedure act;
var l:integer;
begin
  append(f);
  inc(c);l:=lnum;
  writeln(' ',c,':');
  writeln(f,c,':');
  writeln(f,p[ 1]:l,p[ 5]:l,p[ 9]:l,p[ 3]:l,p[ 7]:l,p[10]:l);
  writeln(f,p[25]:l,p[13]:l,p[21]:l,p[27]:l,p[15]:l,p[24]:l);
  writeln(f,p[29]:l,p[17]:l,p[33]:l,p[31]:l,p[19]:l,p[35]:l);
  writeln(f,p[ 4]:l,p[ 8]:l,p[12]:l,p[ 2]:l,p[ 6]:l,p[11]:l);
  writeln(f,p[28]:l,p[16]:l,p[23]:l,p[26]:l,p[14]:l,p[22]:l);
  writeln(f,p[32]:l,p[20]:l,p[34]:l,p[30]:l,p[18]:l,p[36]:l);
  close(f);
  time(1);
end;

procedure perm(x:byte);
var i,o:integer;q,d:longint;
begin
  if stop then exit;
  if x>=xm then xm:=x;
  inc(inf);
  if inf>5000000 then begin
    if key=#27 then stop:=true;
    if pinf<>p[5] then write(#13,c,':',xm-1,':',p[1]:lnum,p[2]:lnum,p[5]:lnum);
    pinf:=p[5];inf:=0
  end;
  o:=2;
  case x of
    1:begin
        while nn>=36 do begin
          q:=0;for i:=1 to nn do q:=q+p[i];q:=q-6*S;
          if (nn=36)and(q<>0) then exit;
          if q<0 then exit;
          if nn=37 then begin
            for i:=1 to nn do if p[i]=q then begin
              dec(nn);for o:=i to nn do p[o]:=p[o+1];
              xm:=0;
              analiz4(0);
              perm(x+1);
            end;
            exit;
          end;
          if string6(1,1)>2 then perm(x+1);
          if stop then exit;
          dec(nn);xm:=0;
          for i:=1 to nn do p[i]:=p[i+1];
          writeln;
          analiz4(0);
        end;
        exit;
      end;
    2,5,6,9,11,13,14,17,21,23,25,29:o:=1;
    3:begin p1:=p[1]+p[2]-Sc;if pnum^[abs(p1)]<cp then exit;o:=1 end;
    4:begin q:=Sc-p1-p[3];if q<p[3] then exit end;
    7:begin p2:=p[5]+p[6]-Sc;if pnum^[abs(p2)]<cp then exit;o:=1 end;
    8:q:=Sc-p2-p[7];
   10:begin if p[7]<p[9] then exit;q:=S-p[1]-p[5]-p[9]-p[3]-p[7] end;
   12:begin p3:=p[9]+p[11]-Sc;if pnum^[abs(p3)]<cp then exit;q:=Sc-p3-p[10] end;
   15:begin p5:=p[13]+p[14]-Sc;
        if pnum^[abs(p5)]<cp then exit;p9:=-p1-p5;
        if pnum^[abs(p9)]<cp then exit;p4:=p9-p2;
        if pnum^[abs(p4)]<cp then exit;p7:=-p3-p5;
        if pnum^[abs(p7)]<cp then exit;p6:=p7-p2;
        if pnum^[abs(p6)]<cp then exit;p8:=p1-p6;
        if pnum^[abs(p8)]<cp then exit;o:=1 end;
   16:q:=Sc-p5-p[15];
   18:begin if p[16]<p[17] then exit;q:=Sc+p8-p[17] end;
   19:q:=S-p[7]-p[15]-p[6]-p[14]-p[18];
   20:q:=Sc-p8-p[19];
   22:q:=Sc+p6-p[21];
   24:q:=Sc-p6-p[23];
   26:q:=Sc+p4-p[25];
   27:q:=S-p[25]-p[13]-p[21]-p[15]-p[24];
   28:q:=Sc-p4-p[27];
   30:q:=Sc+p7-p[29];
   31:q:=S-p[3]-p[27]-p[2]-p[26]-p[30];
   32:q:=Sc-p7-p[31];
   33:q:=S32-p[1]-p[9]-p[7]-p[29]-p[19]-p[28]-p[23]-p[14];
   34:q:=S-p[9]-p[21]-p[33]-p[12]-p[23];
   35:q:=Sc-p9-p[34];
   36:q:=Sc+p9-p[33];
   37:begin act;exit end;
  end;
  d:=p[x];
  case o of
    1:begin
      i:=x;
        repeat
          p[x]:=p[i];p[i]:=d;mask^[p[x]]:=x;mask^[p[i]]:=i;
          perm(x+1);
          p[i]:=p[x];p[x]:=d;mask^[p[x]]:=x;mask^[p[i]]:=i;
          inc(i)
        until i>nn;
      end;
    2:begin
        if (q<pmin)or(q>pmax) then exit;
        if mask^[q]<x then exit else i:=mask^[q];
        p[x]:=p[i];p[i]:=d;mask^[p[x]]:=x;mask^[p[i]]:=i;
        perm(x+1);
        p[i]:=p[x];p[x]:=d;mask^[p[x]]:=x;mask^[p[i]]:=i;
      end;
  end;
end;

{ —Ёб«® 6-®Є б б㬬®© S б।Ё p[x],...,p[nn] Ё ЇҐаўл¬ н«Ґ¬Ґ­в®¬ p[i] (i>=x) }
function string6(x,i:integer):integer;
var q:longint;c:integer;

  procedure test6(x,k:integer;s:longint);
  var i:integer;
  begin
    for i:=k to nn-6+x do begin
      if p[i]<=s then
      if x=6 then begin if p[i]=s then inc(c) end
      else test6(x+1,i+1,s-p[i]);
    end;
  end;

begin
  c:=0;
  q:=p[x];p[x]:=p[i];p[i]:=q;
  test6(2,x+1,S-p[x]);
  q:=p[x];p[x]:=p[i];p[i]:=q;
  string6:=c
end;

procedure delm(x:integer);
var i,l:integer;
begin
  i:=0;l:=1;pmax:=0;pmin:=Sc;
  repeat
    if (l>i)and(m[l]>=x) then begin
      inc(i);m[i]:=m[l];p[i]:=p[l];
      if p[i]<pmin then pmin:=p[i];
      if p[i]>pmax then pmax:=p[i];
    end;
    inc(l);
  until l>nn;nn:=i;
end;

procedure analiz4(x:byte);
var i,j,k,l:integer;q:longint;

  procedure inc2(var x:byte);
  begin if x<255 then inc(x) end;

begin
  Nq:=0;
  for i:=1 to nn do m[i]:=0;
  for i:=0 to Sc do pnum^[i]:=0;
  if nn>3 then
  for i:=1 to nn-3 do for j:=i+1 to nn-2 do
  for k:=j+1 to nn-1 do for l:=k+1 to nn do
    if p[i]+p[j]+p[k]+p[l]=2*Sc then begin
      inc2(m[i]);inc2(m[j]);inc2(m[k]);inc2(m[l]);
      inc2(pnum^[abs(p[l]+p[k]-Sc)]);
      inc2(pnum^[abs(p[l]+p[j]-Sc)]);
      inc2(pnum^[abs(p[l]+p[i]-Sc)]);
      inc(Nq)
    end;
  delm(1);
  if nn<36 then exit;
  q:=0;for i:=1 to nn do q:=q+p[i];
  if (nn=36)and(q<>6*S) then begin nn:=0;exit end;
  sort(1,nn);
  if x=0 then begin
    q:=pmax;lnum:=2;while q>=10 do begin inc(lnum);q:=q div 10 end;
    writeln('NQ=',Nq,'(',m[1],') Sc=',Sc,' N=',nn,': ',pmin,'...',pmax);
    for i:=1 to nn do begin write(p[i]:lnum);if wherex>70 then writeln end;
    writeln;
  end;
end;

procedure start;
var i,j:integer;ok:boolean;
label ex;
begin
  window(2,4,79,24);textbackground(1);clrscr;
  S32:=3*S div 2;Sc:=S div 3;
  for i:=1 to nn do m[i]:=0;sort(1,nn);
  j:=0;repeat inc(j);c:=string6(j,j) until (c>2)or(j>nn-36);nn:=nn-j+1;
  if (c<3)or(nn<36) then begin writeln('Count=0');exit end;
  if j>1 then for i:=1 to nn do p[i]:=p[i+j-1];
  writeln('Start N=',nn,' ',p[1]);
  getmem(pnum,2*Sc);
  repeat
    analiz4(0);
    if nn<=36 then break;
    ok:=false;
    writeln('[1]-New N, [2]-Del, [Space]-run');
    repeat until keypressed;
    case key of
      ' ':ok:=true;
      '1':begin
            write('N=');readln(i);if i<36 then i:=36;
            while i<nn do begin
              dec(nn);
              for j:=1 to nn do p[j]:=p[j+1];
              analiz4(1);
            end;
          end;
      '2':begin
            dec(nn);
            for j:=1 to nn do p[j]:=p[j+1];
          end;
    end;
  until ok;
  c:=0;
  if nn<36 then goto ex;
  getmem(mask,pmax*sizeof(integer));
  for i:=0 to pmax do mask^[i]:=0;
  for i:=1 to nn do mask^[p[i]]:=i;
  oname:='Diab.txt';
  assign(f,oname);append(f);if ioresult<>0 then rewrite(f);
  writeln(f,'Summa=',S);close(f);
  stop:=false;inf:=0;pinf:=0;xm:=0;
  time(0);
  perm(1);writeln;
  time(1);
  freemem(mask,nn);
ex:
  freemem(pnum,2*Sc);
  writeln('Count=',c);
end;

procedure view;
const fi:array[0..1] of string=('off','on');
begin
  window(2,3,79,3);textbackground(0);clrscr;
  write('Summa=',S,' Nmax=',nn0,' File=',iname,' CP=',cp,
        ' Filter=',fi[filt]);
end;

procedure err(m:string);
begin
  window(32,12,79,12);textbackground(1);clrscr;
  write(m);
end;

procedure p_inp;
begin
  if iname='' then iname:='smith.txt';
  assign(f,iname);reset(f);
  if ioresult<>0 then begin
    err('Error open file "'+iname+'"');exit end;
  i:=0;
  repeat
    read(f,c);
    if ((c mod 9)=4)or(filt=0) then
    if c<2*S div 3 then begin inc(i);p[i]:=c end;
  until eof(f) or (i>=nn0);
  close(f);
  while (p[i]=0)and(i>0) do dec(i);nn:=i;
  if nn=36 then begin
    S:=0;for i:=1 to nn do S:=S+p[i];
    if (S mod 36)<>0 then err('Error S');
    S:=S div 6;
  end;
end;

procedure menu;
begin
  p_inp;
  repeat
    view;
    window(2,24,79,24);textbackground(0);clrscr;
    write('[1]-Summa [2]-File [3]-Nmax [4]-CP [5]-Filter [Esc]-EXIT');
    repeat until keypressed;
    case key of
      #27:exit;
      '1':if nn>36 then begin clrscr;write('Summa=');readln(S);
            if (S mod 6)<>0 then err('Error S') end;
      '2':begin clrscr;write('File=');readln(iname);p_inp end;
      '3':begin clrscr;write('Nmax=');readln(nn0);if nn0>nmax then nn0:=nmax;p_inp end;
      '4':begin clrscr;write('cp(1..)=');readln(cp);if cp<1 then cp:=1 end;
      '5':begin filt:=1-filt;p_inp end;
      else begin
        start;
        p_inp;
      end;
    end;
  until false
end;

begin
  textbackground(0);clrscr;
  writeln(svb:79);
  writeln('Diabolic 6x6 v.5':45);
  window(2,4,79,24);textbackground(1);clrscr;
  assign(f,'diab.ini');reset(f);
  if ioresult=0 then begin read(f,S);close(f) end else S:=5856;
  nn0:=100;cp:=1;
  iname:=paramstr(1);
  menu;
  assign(f,'diab.ini');rewrite(f);
  writeln(f,S);close(f);
end.

Поясню ещё раз, как работает программа.
При запуске программы в окне появляется меню, реализованное нажатием цифровых клавиш.
Пункт меню - File - реализуется нажатием клавиши 2. Вводим имя файла, в котором у нас записан всего один потенциальный массив. Программа считывает этот массив и начинает его проверять.
Если массив состоит точно из 36 чисел, то магическую константу задавать не нужно, программа вычислит её сама по данному массиву. А у нас сейчас именно такой случай, что массив всегда состоит точно из 36 последовательных простых чисел.
Ну вот, собственно, и всё. Дальше начинается проверка введённого массива на предмет построения квадрата.
Проверка выполняется довольно быстро - несколько секунд. После чего программа свою миссию закончила и "уходит". Чтобы проверить следующий массив, надо всё проделать заново: записать новый массив во входной файл, запустить программу, ввести пункт меню File, ввести имя файла.
Представили, да? И так через каждые 5-30 секунд. Весёленькое занятие