Цитата(proger @ 6.3.2006, 11:29  ) | | mes, А прогу нАПИСАТЬ МОЖЕШЬ, А ТО У МЕНЯ НЕ ПОЛУЧАЕТСЯ! |
Вариантов для написания проги очень много. В зависимости от того что тебе надо.
Думаю, что тебе важно, чтоб компьютер перебрал все возможные варианты независимо от того являются ли они симметричными.
Чтоб проверять только те позиции, которые имеет смысл, я разбил задачу на две части.
Первая: Как известно конь не может бить угловые клетки в разных углах. Таких клеток 16. (4*4)
Вопрос: Могут ли бить 12 коней ети 16 клеток?
Каждая клетка может бить "бита" не более чем с девяти позиций: (8 битых +1 когда клетка занята конём)
Конь может бить две соседние клетки, только если они рассположены по диагонали
| Код |
program konA;
{$APPTYPE CONSOLE}
uses
SysUtils,
windows;
TYPE Tkletka = record v: 'A'..'H';
h: '1'..'8';
end;
TKonPos = array[0..8] of byte;
const UgolKletka: array[0..3] of array [0..3] of Tkletka =
(((v:'A';h:'1'),(v:'A';h:'2'),
(v:'B';h:'1'),(v:'B';h:'2')),
((v:'H';h:'1'),(v:'H';h:'2'),
(v:'G';h:'1'),(v:'G';h:'2')),
((v:'A';h:'8'),(v:'A';h:'7'),
(v:'B';h:'8'),(v:'B';h:'7')),
((v:'H';h:'8'),(v:'H';h:'7'),
(v:'G';h:'8'),(v:'G';h:'7')));
var Kon: array [0..5] of record pos:TKonPos end;
Reslt: record kol:byte;
Kon: array [0..3] of record pos:TKonPos end;
end;
i,j:integer;
n:byte;
function KletkaToByte (nkletka:Tkletka):byte;
begin
Result := (byte(nkletka.v)-byte('A')) shl 3 +(byte(nkletka.h)-byte('1'));
end;
{Проверка горизонтали и вертикали: если на доске, то определяет порядковый номер;}
function NaDoske(v,h:byte; var Nummer:byte):boolean;
begin
if (v<8) and (h<8)
then begin
Nummer := (v shl 3)+h;
Result:=True;
end
else Result :=False;
end;
function Kletka (v,h:Char):Tkletka;
begin
Result.v:=v;
Result.h:=h;
end;
function ByteToKletka(num:byte):Tkletka;
begin
Result.v:=char(byte('A')+((num shr 3) and 7));
Result.h:=char(byte('1')+ (num and 7));
end;
{Преоброзавание в строку "легальных" позиций}
Function KonPosToStr (KonPos:TKonPos):string;
var i:integer;
s:string;
kl:Tkletka;
begin
s:='';
For i:=0 to 8 do
if KonPos[i]<64 then begin kl:=ByteTokletka(KonPos[i]);
s:=s+' '+kl.v+':'+kl.h+';';
end;
Result:=S;
end;
{Перебор возможных вариантов конём}
Procedure FindBitoePole (Kletka:Tkletka; out KonPos:TKonPos);
v,v1,h,h1: byte;
n:byte;
begin
v:= (byte(kletka.v)-byte('A'));
h:= (byte(kletka.h)-byte('1'));
n:=0;
if not(NaDoske (byte(v-2),byte(h-1),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v-2),byte(h+1),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v-1),byte(h-2),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v-1),byte(h+2),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v+2),byte(h-1),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v+2),byte(h+1),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v+1),byte(h-2),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
if not(NaDoske(byte(v+1),byte(h+2),KonPos[n]))
then KonPos[n]:=$FF; Inc(n);
NaDoske (v,h,KonPos[n]);
end;
function IsKonDljaDvux (KonPos1, KonPos2:TKonPos; out KonPos:TKonPos):byte;
var i,j:integer;
n:byte;
test:boolean;
begin
n:=0;
for i:=0 to 8 do
begin
test:=False;
for j:=0 to 8 do
if (KonPos1[i] = KonPos2[j]) and ((KonPos1[i] or KonPos2[j])<64)
then test:=True;
if test then
begin
KonPos[i]:=KonPos1[i]; Inc (n)
end
else KonPos[i]:=$FF;
end;
Result:=n;
end;
begin
n:=1; {Номер текущего коня}
for j:=0 to 3 do {Проверить четыре угла}
begin
writeln ('Ugol ',j+1);
for i:=0 to 3 do
FindBitoePole (UgolKletka[j][i], Kon[i].pos); {Определить поля, с которых клетка бита}
if IsKonDljaDvux (Kon[0].pos, Kon[3].pos, kon[4].pos)>0 {Проверить диагональные клетки на совпадение}
then writeln ('Kon ',n,': ',KonPosToStr (kon[4].pos)) {Если совпадают, то распечатать только совпадающие позиции}
else
begin
writeln ('Kon ',n,': ',KonPosToStr (kon[0].pos)); Inc(n); {Иначе все возмозные}
writeln ('Kon ',n,': ',KonPosToStr (kon[3].pos));
end;
Inc(n);
if IsKonDljaDvux (Kon[1].pos, Kon[2].pos, kon[5].pos)>0 {Проверить другие диагональные клетки на совпадение}
then writeln ('Kon ',n,': ',KonPosToStr (kon[5].pos)) {Если совпадают, то распечатать только совпадающие позиции}
else begin
writeln ('Kon ',n,': ',KonPosToStr (kon[1].pos)); Inc(n);{Иначе все возмозные}
writeln ('Kon ',n,': ',KonPosToStr (kon[2].pos));
end;
Inc(n);
writeln ;
end;
MessageBox (0,'','',0); {поставил для паузы}
end.
// Код конечно нуждается в доработке (написан на скорую руку). :)
|
По результату программы видно, что минимальное кол-во коней для перекрытия угловых клеток нужно 12 (нас это устраивает)
4 Коня имеют 5 позиций,
другие 4 - 3позиции,
и еше 4 Коня могут находится только в 1 положении, значит расставлять нужно только 8 коней.
На основе етих данных я создал, список позиций, и методом перебора проверил есть ли среди вариантов такие,
которые бы били бы все клетки.
| Код |
program konB;
{$APPTYPE CONSOLE}
uses windows,
SysUtils;
TYPE Tkletka = record v: 'A'..'H';
h: '1'..'8';
end;
const Kon1 : Array [0..3] of array [0..4] of tkletka =
(((v:'A'; h:'4'),(v:'D'; h:'1'),(v:'D';h:'3'),(v:'C'; h:'4'),(v:'B'; h:'2')),
((v:'E'; h:'1'),(v:'E'; h:'3'),(v:'F';h:'4'),(v:'H'; h:'4'),(v:'G'; h:'2')),
((v:'A'; h:'5'),(v:'D'; h:'6'),(v:'D';h:'8'),(v:'C'; h:'5'),(v:'B'; h:'7')),
((v:'E'; h:'6'),(v:'E'; h:'8'),(v:'F';h:'5'),(v:'H'; h:'5'),(v:'G'; h:'7')));
Kon2 : Array [0..3] of array [0..2] of tkletka =
(((v:'C';h:'2'),(v:'B'; h:'3'),(v:'A'; h:'1')),
((v:'F';h:'2'),(v:'G'; h:'3'),(v:'H'; h:'1')),
((v:'C';h:'7'),(v:'B'; h:'6'),(v:'A'; h:'8')),
((v:'F';h:'7'),(v:'G'; h:'6'),(v:'H'; h:'8')));
Kon3 : Array [0..3] of tkletka =
((v:'C';h:'3'),(v:'F'; h:'3'),(v:'C'; h:'6'),(v:'F';h:'6'));
var n,i,j,i1,i2,i3,i4,i5,i6,i7,i8:integer;
desk: array[0..63] of byte;
function NaDoske(v,h:byte; var Nummer:byte):boolean;
begin
if (v<8) and (h<8)
then begin
Nummer := (v shl 3)+h;
Result:=True;
end
else Result :=False;
end;
procedure MarkBitye (var Desk:array of byte; konPos:tkletka);
var
v,v1,h,h1: byte;
n:byte;
begin
v:= (byte(KonPos.v)-byte('A'));
h:= (byte(KonPos.h)-byte('1'));
if NaDoske (byte(v-2),byte(h-1),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v-2),byte(h+1),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v-1),byte(h-2),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v-1),byte(h+2),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v+2),byte(h-1),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v+2),byte(h+1),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v+1),byte(h-2),n)
then Desk[n]:= Desk[n] or 1;
if NaDoske(byte(v+1),byte(h+2),n)
then Desk[n]:= Desk[n] or 1;
NaDoske (v,h,n);
Desk[n]:= $FF; {$FF - место занятое конём
1- битое поле;
or 1- используется для того, чтоб не перемаркировать поле помеченное конём}
end;
function Pustye (var desk:array of byte):boolean;
var i:integer;
begin
Result:=false;
for i:=0 to 63 do if desk[i] = 0 then Result:=true;
end;
begin
for i1:=0 to 4 do
for i2:=0 to 4 do
for i3:=0 to 4 do
for i4:=0 to 4 do
for i5:=0 to 2 do
for i6:=0 to 2 do
for i7:=0 to 2 do
for i8:=0 to 2 do
begin
FillChar(desk,Sizeof(desk),0);
MarkBitye(desk,Kon1[0,i1]);
MarkBitye(desk,Kon1[1,i2]);
MarkBitye(desk,Kon1[2,i3]);
MarkBitye(desk,Kon1[3,i4]);
MarkBitye(desk,Kon2[0,i5]);
MarkBitye(desk,Kon2[1,i6]);
MarkBitye(desk,Kon2[2,i7]);
MarkBitye(desk,Kon2[3,i8]);
MarkBitye(desk,Kon3[0]);
MarkBitye(desk,Kon3[1]);
MarkBitye(desk,Kon3[2]);
MarkBitye(desk,Kon3[3]);
if not(Pustye (desk)) then
begin
for i:=0 to 7 do
begin
writeln;
for j:=0 to 7 do
if desk[i*8+j]=1 then write('* ') else write ('K ');
end;
end;
end;
|
В результате два варианта (зеркальных) где группа из трех коней, симметрична относительно поворота.
При проверке во второй части перебираются 50625 позиций.
Если учитывать симметрию относительно поворота, (т.е для одного угла) , то сократится приблизительно до 15 позиций.
Надеюсь тебе ето поможет. 
P.S. Прошу прощение за малое кол-во комментариев и неформатированный код. |
