Задача о 19 ферзях.

Задача о 19 ферзях. Надо раставить 9 чёрных и 10 белых ферзей
так что бы чёрные не били белых а белые соотвествено чёрных, автор В. Франген, 1980 г..
Всего извесно 3 решения на доске 8 на 8, требуется написать программу которая находит все варианты. Так же можно найти решения на больших досках N*N.
Кому интересно могут попробовать создать прогу. Правда по утверждения одного академика что чисто переборный алгоритм не реален, типа при 1000'000'000 расстановок в сек. не найдёт и через 25000 лет, но по ходу этот акадэмик лопух (с).
Задачу эту нашёл в ж. "Наука и Жизнь" №10 1986 г. стр. 108.

 

Кстати того лопуха зовут Кандидат физико-математических наук Б. Лурье.

 

Intro
Всего известно 3 или пока известно 3?

 

Intro
переьорное решение требует только самые базовые знания Паскаля или си, вместо этой галиматьи мог бы сразу написать код. А миллиард это 5 минут работы современной персоналки.

 

для 8*8 явно можно было перебрать все варианты

 

http://www.wasm.ru/forum/viewtopic.php?id=15169

 

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

 

Вариантов расстановки 9 чёрных ферзей на 64-клеточной доске всего 64!/(55!*9!)=2,7540584512e+10. В каждом из них надо проверить наличие хотя бы 10 небитых клеток.

 

Это интересно! То есть по сути задача не про 20 ферзей, а про 9 ферзей, как их расставить, чтобы 10 клеток были небитыми. Потом в них можно поставить 10 белых и усе...

 

persicum
Не верно, 10 клеток будут бить другие клетки.

 

Booster
Не верно, если клетку никто из ферзей не бьет, то и поставленный в нее ферзь никого бить не будет. Доказывается методом "от противного".

 

Booster
фигня имхо, если черный ферзь не бьет белого, то и белый не бьет черного. Не божет быть другого.

 

Согласен, осталось только найти 10 клеток.

 

Код (Text):

1. b000bb00
2. bb000b00
3. bb000000
4. 0b000000
5. 000000ww
6. 00w000ww
7. 00ww000w
8. 00ww0000

При тупом полном переборе первый вариант вылазит уже через несколько секунд, а остальные можете сами поискать =)))

 

Академик, мля...

 

Задачка заинтересовала вас однако, ну ладно вот код на делфи.

Код (Text):

1. program Project1;
2.  
3. // Задача о 19 ферзях. Надо раставить 9 чёрных и 10 белых ферзей
4. // так что бы чёрные не били белых а белые соотвествено чёрных
5. // Эта программа находит все возможнные варианты сразу исключая перевёрнутые и зеркальные.
6. // Ver 1.1  ;-)
7. {$APPTYPE CONSOLE}
8.  
9. uses
10.   SysUtils, Windows;
11.  
12. const NX: array [1..8] of integer=(-1,0,1,-1,1,-1, 0, 1);
13.       NY: array [1..8] of integer=( 1,1,1, 0,0,-1,-1,-1);
14.       FerBlack = 10; // Кол чёрных ферзей.
15.       FerWhite = 9;// Кол белых ферзей.
16.       KonKlet = 63-FerBlack;
17.       MaxVar=2000;// максимум растановок
18. var M : array [0..7,0..FerBlack+1] of cardinal;
19.     M1,M2 : array [0..7] of cardinal;
20.     Bm : array [0..63,0..7] of cardinal;
21.     KB : array [0..255] of byte;
22.     Pole : array [0..7,0..7] of integer;
23.     PoleRes : array [1..MaxVar,0..7,0..7] of integer;
24.     Fg : array [0..3] of string;
25.     MXY : array [0..FerBlack+1] of integer;
26.     i,i1,X,Y,X1,Y1,Nz, XY, XY1, Ot, InitParam, A1 : integer;
27.     t, t1, Bt, Br, g, g1: cardinal;
28.     A : boolean;
29.     Tm1, Tm2, TmSec : Extended;
30.     Text : PChar;
31.     Str1 : string;
32.     Res : TextFile;
33.     {Ad, Ad1: pointer;
34.     W : THandle;
35.     TemplateName : PChar;
36.     Par : HWND;
37.     DialogFunc : TFarProc; }
38. procedure Init;
39. begin
40.   //Ad:=Addr(M1[0]);
41.   //Ad1:=Addr(KB[0]);
42.   Br:=0;g:=0;
43.   Fg[0]:='  ';Fg[1]:='ЫЫ';Fg[2]:='qp';Fg[3]:='db';
44.   for i:=0 to 7 do M[i,1]:=0;
45.   for XY:=0 to 63 do
46.     begin
47.       for i:=0 to 7 do Bm[XY,i]:=0;//Bm[XY,1]:=0;
48.       X:=XY div 8;Y:=XY mod 8;
49.       for Nz:=1 to 8 do
50.         begin
51.           X1:=X;Y1:=Y;
52.           while not((X1>7) or (X1<0) or (Y1>7) or (Y1<0)) do
53.           begin
54.             t:=X1;// div 4;
55.             t1:=Y1;//+(X1 mod 4)*8;
56.             Bt:=1 shl t1;
57.             Bm[XY,t]:=Bm[XY,t] or Bt;
58.             X1:=X1+NX[Nz];
59.             Y1:=Y1+NY[Nz];
60.           end;
61.           //Bm[X*8+Y,t]:=Bm1;
62.         end;
63.     end;
64.   for i:=0 to 255 do
65.     begin
66.      t1:=i;KB[i]:=0;
67.      for i1:=1 to 8 do
68.        begin
69.          t:=t1 mod 2;
70.          t1:=t1 div 2;
71.          KB[i]:=KB[i]+(1-t);
72.        end;
73.     end;
74. end;
75. Procedure Prover;
76. var XY, X1, Y1, k, k1 : integer;
77.     NewV : boolean;
78. Label L1;
79. begin
80.   XY:=0;//M2[0]:=M1[0]; M2[1]:=M1[1];
81.   for i:=0 to 7 do M2[i]:=M1[i];
82.   for Y:=0 to 7 do
83.    begin
84.     for X:=0 to 7 do
85.      begin
86.        t:=XY mod 8;
87.        t1:=M2[t] mod 2;
88.        M2[t]:=M2[t] div 2;
89.        //X1:=XY div 8;Y1:=XY mod 8;
90.        Pole[X,Y]:=0;
91.        if t1=0 then Pole[X,Y]:=2;
92.        inc(XY);
93.      end;
94.    end;
95.   for i:=1 to FerBlack do
96.     begin
97.       X:=MXY[i] div 8;Y:=MXY[i] mod 8;
98.       Pole[X,Y]:=1;
99.     end;
100.   if g>0 then
101.     begin
102.       for g1:=1 to g do
103.        begin
104.         for i:=1 to 7 do
105.          begin
106.            for Y:=0 to 7 do
107.             for X:=0 to 7 do
108.               begin
109.                 case i of
110.                  1: begin X1:=Y;   Y1:=7-X; end;
111.                  2: begin X1:=7-X; Y1:=7-Y; end;
112.                  3: begin X1:=7-Y; Y1:=X;   end;
113.                  4: begin X1:=7-X; Y1:=Y;   end;
114.                  5: begin X1:=Y;   Y1:=X;   end;
115.                  6: begin X1:=X;   Y1:=7-Y; end;
116.                  7: begin X1:=7-Y; Y1:=7-X; end;
117.                 end;
118.                 if PoleRes[g1,X,Y]<>Pole[X1,Y1] then goto L1;
119.               end;
120.             //найден зеркальный вариант!!!
121.             Exit;
122. L1:         //  Следущий переворот.
123.           end;
124.         end;
125.     end;
126.   inc(g);k1:=1;
127.   if g>MaxVar then begin MessageBoxA(0, 'Слишком много вариантов','Ошибка',MB_OK); halt;
128.  
129. end;
130.   writeln;
131.   writeln('Naideno ',g);
132.   writeln('   A B C D E F G H');
133.   writeln(Res);
134.   writeln(Res,'Найден вариант - ',g);
135.   writeln(Res,'   A B C D E F G H');
136.   for Y:=7 downto 0 do
137.    begin
138.     write(Y+1,' ');
139.     write(Res,Y+1,' ');
140.     for X:=0 to 7 do
141.      begin
142.        k:=Pole[X,Y];
143.        if k>0 then begin write(Fg[k+1]); write(Res, Fg[k+1]); end
144.               else begin write(Fg[k1 mod 2]); write(Res, Fg[k1 mod 2]); end;
145.        PoleRes[g,X,Y]:=k;
146.        inc(k1);
147.      end;
148.     writeln;
149.     writeln(Res);inc(k1);
150.    end;
151.   writeln;
152.   Tm2:=Time;
153.   TmSec:=(Tm2-Tm1)*24*60*60;
154.   writeln;
155.   writeln(TmSec:6:4,' Sec');
156.   writeln(Res);
157. end;
158. Procedure Nayti(XY,N : Integer);
159. var B1, XY1, M1a : Integer;
160.     //B : byte;
161. Label L3;
162. begin
163.   for XY1:=XY to KonKlet+N do
164.     begin
165.       if (Br mod $10000)=0 then write('*');
166.       Inc(Br);
167.       MXY[N]:=XY1;
168.       B1:=0;
169.       for i:=0 to 7 do
170.         begin
171.           M1a:=M[i,N-1] or Bm[XY1,i];
172.           B1:=B1+KB[M1a];
173.           M1[i]:=M1a;
174.         end;
175.       if B1>=FerWhite then
176.         begin
177.           for i:=0 to 7 do M[i,N]:=M1[i];
178.           if N=FerBlack then
179.              begin Prover; exit;  end;
180.           Nayti(XY1+1,N+1);
181.         end;  
182.     end;
183. end;
184.   //M1[0]:=M[0,N-1] or Bm[XY,0];
185.   //M1[1]:=M[1,N-1] or Bm[XY,1];
186.   //X:=XY div 8;Y:=XY mod 8;
187.   //Pole[X,Y,N]:=1;
188.     {KB[0]:=KB[0];
189.   Asm
190.     PUSH EAX
191.     PUSH EBX
192.     PUSH ECX
193.     PUSH EDX
194.     MOV EDX, 0   //количество бит = 1
195.     MOV ECX, 8   //счётчик
196.     MOV EBX, Ad  //указатель на масcив М1
197. L1: MOV EAX, DWORD PTR [EBX]
198.     AND EAX, $000000FF //A:=M[Ad] ptr byte
199.     ADD EAX, Ad1
200.     MOV AL, BYTE PTR [EAX]     //A:=KB[Ad1]
201.     AND EAX, $000000FF
202.     ADD EDX, EAX
203.     INC EBX
204.     DEC ECX
205.     JNZ L1
206.     MOV B1, EDX
207.     POP EDX
208.     POP ECX
209.     POP EBX
210.     POP EAX
211.   end;    }
212.   //M[0,N]:=M1[0];M[1,N]:=M1[1];
213.  
214.  
215. //******************************************
216. begin
217. // Задача о 19 ферзях. Надо раставить 9 чёрных и 10 белых ферзей
218. // так что бы чёрные не били белых а белые соотвественно чёрных.
219. // Эта программа находит все возможнные варианты сразу исключая перевёрнутые и зеркальные.
220. AssignFile(Res,'Resultat.txt');
221. Rewrite(Res);
222. Text:='Задача о 19 ферзях. Надо раставить 9 чёрных и 10 белых ферзей так '+#10+
223.       'что бы чёрные не били белых а белые соотвественно чёрных.'+#10+
224.       'Эта программа находит все возможнные варианты, сразу исключая перевёрнутые и
225.  
226. зеркальные.'+#10+
227.       'Продолжить расчёт?';
228. write(Text);
229. write(Res, Text);
230. Ot:=MessageBoxA(0,Text,'Задача о 19 ферзях.', MB_YesNo);
231. if Ot=ID_No then exit;
232. Init;
233. Tm1:=Time;
234. Nayti(0,1);
235. Tm2:=Time;
236. TmSec:=(Tm2-Tm1)*24*60*60;
237. writeln;
238. writeln(TmSec:6:4,' Sec');
239. writeln('Kol variantov - ',Br);
240. writeln('Skorost ',(Br/TmSec):8:0,' variantov/sek');
241. writeln(DateToStr(Date),'  ',TimeToStr(Time));
242. writeln(Res,'Время ',TmSec:6:4,' сек');
243. writeln(Res,'Скорость ',(Br/TmSec):8:0,' вариантов/сек');
244. writeln(Res,'Количество провереных растановок ферзей - ',Br);
245. writeln(Res,DateToStr(Date),' г. ',TimeToStr(Time));
246. Str1:='Больше решений нет! Время поиска  '+FloatToStr(TmSec)+' сек';
247. MessageBoxA(0, PChar(Str1),'Конец',MB_OK);
248. Close(Res);
249. end.

Прога довольно шустрая получилась можно менять количество ферзей, товарищи которые догадались расматривать только черные ферзи совершено правы, резко уменьшается количество переборов. Прога результат сохраняет в файле Resultat.txt, работает шустро 1.5-2.5 сек. Там ещё есть код асм это моя неудачная попытка написать часть функции найти на асме, в прочим она и так достаточно быстро работает, так же прога сама отсекает зеркальные и перевёрнутые варианты. Эту прогу давно написал на зло тому академику.

 

Intro
Чёт по быдлокодерски. Можно сделать соответствие позиций и полей, которые оно бьёт. Когда ставим фигуру, то вычитаем соответствующие поля. Поля можно уместить в 64 битах и применять маски.

 

Да тут есть команда POPCNT подсчёт количества бит тока как я понимаю это SSE4 по ходу.
А у меня на данный момент атлон ХР 2200 был семпрон 2500 (64) но здох.
Там всё просто, поле битовое, логически сложивается на маску M1a:=M[i,N-1] or Bm[XY1,i] в маске все варианты битых полей всех позиций ферзя, а потом подсчитавается количество бит B1:=B1+KB[M1a];, это делается по байтно по этому цикл 8 раз, алгоритм рекурсивный, может несколько замороченый но работает же.
Если использовать SSE4 с POPCNT то прогу можно резко ускорить, лог. сложил и подсчитал биты которые за пустые т.е. не битые клетки отвечают и далее по рекурсии.
Можно сразу в SSE лог сложить 64бит а потом по байтно под считать кол. бит но мне так проще было сделать хотя там ниже видно что я пытался на асемблере так сделать но чота не получилось может надо всю задачу решать на асме но у меня чота плохо сним получается, хотя раньше на Интел8080 проги мог составлять.

 

>Задачка заинтересовала вас однако, ну ладно вот код на делфи.

Ну вы батенька сначала лопушком прикинулись, потом SSE4 вам подавай... Подколоть хотели?

Задачу то решил Ваш покорный слуга, а остальные решения легко получаются из этой картинки вручную.

 

Вот версия 1.3 этой проги коректно расчитывает если ферзей меньше 19, хотя могут быть вылеты если меньше 17 ферзей из-за переполнения массива где хранятся найденые варианты, макс 5000, а так же могут не правельно пустые клетки находится если их больше 2-х, но это врятли.
И ещё быстрей работать стала, на атлон ХР 2200 за 0.530-0.560 сек находит в варианте 19 ф. 9+10.