Брут задачи Эйнштейна

unit UMain;
(*
5 разных человек в 5 разных домах разного цвета, курят 5 разных марок сигарет, выращивают 5 разных видов животных, пьют 5 разных видов напитков.

Вопрос: Кто выращивает рыбок?

1. Норвежец живет в первом доме.
2. Англичанин живет в красном доме
3. Зеленый дом находится слева от белого
4. Датчанин пьет чай
5. Тот, кто курит Rothmans, живет рядом с тем, кто выращивает кошек.
6. Тот, кто живет в желтом доме, курит Dunhill
7. Немец курит Marlboro
8. Тот, кто живет в центре, пьет молоко
9. Сосед того, кто курит Rothmans, пьет воду.
10. Тот, кто курит Pall Mall, выращивает птиц.
11. Швед выращивает собак
12. Норвежец живет рядом с синим домом
13. Тот, кто выращивает лошадей, живет в синем доме
14. Тот, кто курит Philip Morris, пьет пиво
15. В зеленом доме пьют кофе

Номер дома 1 2 3 4 5
Цвет дома
Напиток
Животное
Сигареты
Национальность
*)
interface

uses
  Windows, SysUtils, Classes, Forms, ComCtrls, ExtCtrls, Controls;

type
  TFMain = class(TForm)
    cResults: TListView;
    cStart: TPanel;
    procedure cStartClick(Sender: TObject);
  private
    procedure ClearResults;
    procedure GenerateResults;
    procedure ShowResults;
    function  ThisValidResults: BOOL;
  end;

var
  FMain: TFMain;

implementation

{$R *.dfm}

type
  THouse = packed record
    iCountry    : BYTE;
    iColor      : BYTE;
    iAnimal     : BYTE;
    iDrink      : BYTE;
    iCigarettes : BYTE;
  end;
const
  ID_EMPTY        = 0;
  ID_NORWEGIAN    = 1;
  ID_ENGLISHMAN   = 2;
  ID_DANE         = 3;
  ID_GERMAN       = 4;
  ID_SWEDISH      = 5;
  ID_RED          = 1;
  ID_BLUE         = 2;
  ID_YELLOW       = 3;
  ID_GREEN        = 4;
  ID_WHITE        = 5;
  ID_CATS         = 1;
  ID_HORSES       = 2;
  ID_DOGS         = 3;
  ID_BIRDS        = 4;
  ID_FISH         = 5;
  ID_TEA          = 1;
  ID_COFFEE       = 2;
  ID_MILK         = 3;
  ID_BEER         = 4;
  ID_WATER        = 5;
  ID_PALLMALL     = 1;
  ID_PHILIPMORRIS = 2;
  ID_DUNHILL      = 3;
  ID_MARLBORO     = 4;
  ID_ROTHMANS     = 5;
  aCountry    : packed array [1..5] of string =
  ('Норвежец', 'Англичанин', 'Датчанин', 'Немец', 'Швед');
  aColor      : packed array [1..5] of string =
  ('Красный', 'Синий', 'Желтый', 'Зеленый', 'Белый');
  aAnimal     : packed array [1..5] of string =
  ('Кошки', 'Лошади', 'Собаки', 'Птицы', 'Рыбки');
  aDrink      : packed array [1..5] of string =
  ('Чай', 'Кофе', 'Молоко', 'Пиво', 'Вода');
  aCigarettes : packed array [1..5] of string =
  ('Pall Mall', 'Philip Morris', 'Dunhill', 'Marlboro', 'Rothmans');
var
  aResults    : packed array [1..5] of THouse;

procedure TFMain.ClearResults;
var
  i : BYTE;
begin
  cResults.Items.Clear;
  for i := Low(aResults) to High(aResults) do
    FillChar(aResults[i], SizeOf(THouse), $00);
  aResults[1].iCountry := 1;
  aResults[2].iColor   := 2;
  aResults[2].iAnimal  := 2;
  aResults[3].iDrink   := 3;
end;

procedure TFMain.GenerateResults;
label
  _reload;
const
  ID_COUNTRY    = 1;
  ID_COLOR      = 2;
  ID_ANIMAL     = 3;
  ID_DRINK      = 4;
  ID_CIGARETTES = 5;

  function AlreadyExists(const ItemID, Value: BYTE): BOOL;
  var
    i : BYTE;
  begin
    Result := False;
    for i := Low(aResults) to High(aResults) do
    case ItemID of
      ID_COUNTRY    : if aResults[i].iCountry = Value then begin
                        Result := True;
                        Break;
                      end;
      ID_COLOR      : if aResults[i].iColor = Value then begin
                        Result := True;
                        Break;
                      end;
      ID_ANIMAL     : if aResults[i].iAnimal = Value then begin
                        Result := True;
                        Break;
                      end;
      ID_DRINK      : if aResults[i].iDrink = Value then begin
                        Result := True;
                        Break;
                      end;
      ID_CIGARETTES : if aResults[i].iCigarettes = Value then begin
                        Result := True;
                        Break;
                      end;
    end;
  end;

var
  i     : BYTE;
  Value : BYTE;
begin
  _reload:
  ClearResults;
  for i := Low(aResults) to High(aResults) do begin
    if aResults[i].iCountry = ID_EMPTY then
    repeat
      Value := Random(5)+1;
    until not AlreadyExists(ID_COUNTRY, Value);
    if aResults[i].iCountry = ID_EMPTY then
      aResults[i].iCountry := Value;
  end;
  for i := Low(aResults) to High(aResults) do begin
    case aResults[i].iCountry of
      ID_GERMAN     : aResults[i].iCigarettes := ID_MARLBORO;
      ID_ENGLISHMAN : aResults[i].iColor      := ID_RED;
      ID_DANE       : aResults[i].iDrink      := ID_TEA;
      ID_SWEDISH    : aResults[i].iAnimal     := ID_DOGS;
    end;
  end;
  for i := Low(aResults) to High(aResults) do begin
    if aResults[i].iColor = ID_EMPTY then
    repeat
      Value := Random(5)+1;
    until not AlreadyExists(ID_COLOR, Value);
    if aResults[i].iColor = ID_EMPTY then
      aResults[i].iColor := Value;
  end;
  for i := Low(aResults) to High(aResults) do begin
    case aResults[i].iColor of
      ID_YELLOW : begin
                    if aResults[i].iCountry = ID_GERMAN then
                      goto _reload;
                    aResults[i].iCigarettes := ID_DUNHILL;
                  end;
      ID_GREEN  : begin
                    if (i<>5)and(aResults[i+1].iColor <> ID_WHITE) then
                      goto _reload;
                    aResults[i].iDrink    := ID_COFFEE;
                  end;
    end;
  end;
  for i := Low(aResults) to High(aResults) do begin
    if aResults[i].iCigarettes = ID_EMPTY then
    repeat
      Value := Random(5)+1;
    until not AlreadyExists(ID_CIGARETTES, Value);
    if aResults[i].iCigarettes = ID_EMPTY then
      aResults[i].iCigarettes := Value;
  end;
  for i := Low(aResults) to High(aResults) do begin
    case aResults[i].iCigarettes of
      ID_PALLMALL      : aResults[i].iAnimal := ID_BIRDS;
      ID_PHILIPMORRIS  : aResults[i].iDrink  := ID_BEER;
    end;
  end;
  for i := Low(aResults) to High(aResults) do begin
    if aResults[i].iDrink = ID_EMPTY then
    repeat
      Value := Random(5)+1;
    until not AlreadyExists(ID_DRINK, Value);
    if aResults[i].iDrink = ID_EMPTY then
      aResults[i].iDrink := Value;
  end;
  for i := Low(aResults) to High(aResults) do begin
    case aResults[i].iDrink of
      ID_WATER : begin
                   case i of
                     1 : if aResults[i+1].iCigarettes <> ID_ROTHMANS then
                           goto _reload;
                     5 : if aResults[i-1].iCigarettes <> ID_ROTHMANS then
                           goto _reload;
                     else if (aResults[i-1].iCigarettes <> ID_ROTHMANS)or(aResults[i+1].iCigarettes <> ID_ROTHMANS) then
                           goto _reload;
                   end;
                 end;
    end;
  end;
  for i := Low(aResults) to High(aResults) do begin
    if aResults[i].iAnimal = ID_EMPTY then
    repeat
      Value := Random(5)+1;
    until not AlreadyExists(ID_ANIMAL, Value);
    if aResults[i].iAnimal = ID_EMPTY then
      aResults[i].iAnimal := Value;
  end;
  for i := Low(aResults) to High(aResults) do begin
    case aResults[i].iAnimal of
      ID_CATS : begin
                   case i of
                     1 : if aResults[i+1].iCigarettes <> ID_ROTHMANS then
                           goto _reload;
                     5 : if aResults[i-1].iCigarettes <> ID_ROTHMANS then
                           goto _reload;
                     else if (aResults[i-1].iCigarettes <> ID_ROTHMANS)or(aResults[i+1].iCigarettes <> ID_ROTHMANS) then
                           goto _reload;
                   end;
                 end;
    end;
  end;
end;

procedure TFMain.ShowResults;
var
  i : BYTE;
begin
  cResults.Items.Clear;
  for i := Low(aResults) to High(aResults) do
  with cResults.Items.Add do begin
    Caption := IntToStr(i);
    SubItems.Add(aColor[aResults[i].iColor]);
    SubItems.Add(aCountry[aResults[i].iCountry]);
    SubItems.Add(aCigarettes[aResults[i].iCigarettes]);
    SubItems.Add(aDrink[aResults[i].iDrink]);
    SubItems.Add(aAnimal[aResults[i].iAnimal]);
  end;
end;

function TFMain.ThisValidResults: BOOL;
var
  i        : BYTE;
  abResult : packed array [1..15] of BOOL;
begin
  for i := Low(abResult) to High(abResult) do
    abResult[i] := False;
  for i := Low(aResults) to High(aResults) do begin
    {1. Норвежец живет в первом доме.}
    if (aResults[1].iCountry = ID_NORWEGIAN) then
      abResult[1] := True;
    {2. Англичанин живет в красном доме}
    if (aResults[i].iColor = ID_RED)and(aResults[i].iCountry = ID_ENGLISHMAN) then
      abResult[2] := True;
    {3. Зеленый дом находится слева от белого}
    if (i <> 5)and(aResults[i].iColor = ID_GREEN)and(aResults[i+1].iColor = ID_WHITE) then
      abResult[3] := True;
    {4. Датчанин пьет чай}
    if (aResults[i].iDrink = ID_TEA)and(aResults[i].iCountry = ID_DANE) then
      abResult[4] := True;
    {5. Тот, кто курит Rothmans, живет рядом с тем, кто выращивает кошек.}
    if (i in [1..4])and(aResults[i].iCigarettes = ID_ROTHMANS)and(aResults[i+1].iAnimal = ID_CATS) then
      abResult[5] := True;
    if (i in [2..5])and(aResults[i].iCigarettes = ID_ROTHMANS)and(aResults[i-1].iAnimal = ID_CATS) then
      abResult[5] := True;
    {6. Тот, кто живет в желтом доме, курит Dunhill}
    if (aResults[i].iColor = ID_YELLOW)and(aResults[i].iCigarettes = ID_DUNHILL) then
      abResult[6] := True;
    {7. Немец курит Marlboro}
    if (aResults[i].iCountry = ID_GERMAN)and(aResults[i].iCigarettes = ID_MARLBORO) then
      abResult[7] := True;
    {8. Тот, кто живет в центре, пьет молоко}
    if (aResults[3].iDrink = ID_MILK) then
      abResult[8] := True;
    {9. Сосед того, кто курит Rothmans, пьет воду.}
    if (i in [1..4])and(aResults[i].iCigarettes = ID_ROTHMANS)and(aResults[i+1].iDrink = ID_WATER) then
      abResult[9] := True;
    if (i in [2..5])and(aResults[i].iCigarettes = ID_ROTHMANS)and(aResults[i-1].iDrink = ID_WATER) then
      abResult[9] := True;
    {10. Тот, кто курит Pall Mall, выращивает птиц.}
    if (aResults[i].iAnimal = ID_BIRDS)and(aResults[i].iCigarettes = ID_PALLMALL) then
      abResult[10] := True;
    {11. Швед выращивает собак}
    if (aResults[i].iAnimal = ID_DOGS)and(aResults[i].iCountry = ID_SWEDISH) then
      abResult[11] := True;
    {12. Норвежец живет рядом с синим домом}
    if (aResults[2].iColor = ID_BLUE) then
      abResult[12] := True;
    {13. Тот, кто выращивает лошадей, живет в синем доме}
    if (aResults[2].iAnimal = ID_HORSES) then
      abResult[13] := True;
    {14. Тот, кто курит Philip Morris, пьет пиво}
    if (aResults[i].iDrink = ID_BEER)and(aResults[i].iCigarettes = ID_PHILIPMORRIS) then
      abResult[14] := True;
    {15. В зеленом доме пьют кофе}
    if (aResults[i].iColor = ID_GREEN)and(aResults[i].iDrink = ID_COFFEE) then
      abResult[15] := True;
  end;
  Result := True;
  for i := Low(abResult) to High(abResult) do
    Result := Result and abResult[i];
end;

procedure TFMain.cStartClick(Sender: TObject);
var
  i : BYTE;
begin
  repeat
    GenerateResults;
    ShowResults;
    Application.ProcessMessages;
  until ThisValidResults;
  for i := Low(aResults) to High(aResults) do
    if aResults[i].iAnimal = ID_FISH then begin
      MessageBoxA(Handle, PAnsiChar(AnsiString(aCountry[i]+' выращивает рыбок.')), 'Finish', MB_ICONINFORMATION);
      Break;
    end;
end;

initialization
  Randomize;

end.