用电脑解决爱因斯坦难题
一、问题的提出
爱因斯坦在20世纪初出的这个谜语，题目是这样的：
1、在一条街上，有5座房子，喷了5种颜色。
2、每个房里住着不同国籍的人。
3、每个人喝不同的饮料，抽不同品牌的香烟，养不同的宠物。
提示：
1、英国人住红色房子
2、瑞典人养狗
3、丹麦人喝茶
4、绿色房子在白色房子左面
5、绿色房子主人喝咖啡
6、抽Pall Mall香烟的人养鸟
7、黄色房子主人抽Dunhill香烟
8、住在中间房子的人喝牛奶
9、挪威人住第一间房
10、抽Blends香烟的人住在养猫的人隔壁
11、养马的人住在抽Dunhill香烟的人隔壁
12、抽Blue Master的人喝啤酒
13、德国人抽Prince香烟
14、挪威人住蓝色房子隔壁
15、抽Blends香烟的人有一个喝水的邻居
问题是：谁养鱼？
据说，98%的人答不出这道题！
二、分析
这是一道很典型的逻辑推理题，对于此题使用表格方法，通过假设找出矛盾，从而得到正确答案，是比较快速的方法，但即使是这样我见到的最快解出此题的人也用了十几分钟，那么电脑需要多久呢？答案是不到一秒钟！
如果让电脑完全按人类的推理来进行工作，那恐怕代码要写非常长，而且对于以后遇到类似的问题几乎没有什么参考价值。我们可以采用表格法进行递归穷举，利用电脑的强大的计算能力加上一些不复杂的逻辑来实现它，但是对于5!的5次方超过248亿个可能性，计算量相当的惊人。而采用按“国籍”、“饮料”、“色彩”、“香烟”、“宠物”五项信息依次对表格进行可能性填充，一旦不符合逻辑条件则立即中止向后面的信息进行判断，这样就可大大减少运算次数。
三、设计
我们将使用二维数组InfoArray实现对各信息的初始化，二维数组矩阵Matrix记录表格定义，数组used来存贮与之对应的信息选项是否已用过。AccordWithLogic函数判断是否符合命题逻辑，可以对命题的条件先作一下整理再按信息类别依次来判断，而且输入条件不能涉及到未填充的信息。例如：当前才填充到“饮料”信息就不能去判断涉及到“香烟”的第15个条件，因为还没有向表格中填充任何香烟，那么得出的判断结果是不正确的。FillMatrix函数是程序的主体，它以递归的方式列举了所有的排列可能性。PrintResult函数用于打印结果。
整个代码是一个大循环，使用了backtracing的设计思想。
四、Delphi代码实现
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button4: TButton;
Label1: TLabel;
Label3: TLabel;
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
Matrix: array[0..4 , 0..4] of smallint; //表格
MatrixRowCount: integer = 4; //表格最大行数 ,即信息数
MatrixColCount: integer = 4; //表格最大列数 ,即每项信息的个数
// 实现对各信息的初始化
InfoArray: array[0..4, 0..4] of string =(('挪威人', '英国人', '瑞典人', '丹麦人', '德国人'),
('茶', '咖啡', '牛奶', '啤酒', '水'),
('红色', '绿色', '黄色', '蓝色', '白色'),
('Prince', 'Pall Mall', 'Dunhill', 'Blends', 'Blue Master'),
('狗', '鸟', '马', '猫', '鱼'));
used: array[0..4 , 0..4] of integer; //与InfoArray对应的元素是否已用过
count_get, count_pro: integer; //结果的个数、共进行了多少次递归运算
// 取得信息号和项目序号所对应的值并和给定值进行对比
function CompareItem(InfoID, ItemIndex: Integer; CompareText: string): Boolean;
begin
if (ItemIndex <= MatrixColCount) and (ItemIndex >= 0) then
Result := InfoArray[InfoID, Matrix[InfoID, ItemIndex]] = CompareText
else
Result := False;
end;
// 采用按'国籍'、'饮料'、'色彩'、'香烟'、'宠物'
// 五项信息依次对已生成的序列进行逻辑判断
function AccordWithLogic(InfoID: integer): boolean;
var
ItemIndex: Integer;
begin
Result := True;
for ItemIndex := 0 to 4 do
begin
case InfoID of
0:
begin
if CompareItem(0, ItemIndex, '挪威人') and not (ItemIndex = 0) then
Result := False;
end;
1:
begin
if (CompareItem(1, ItemIndex, '茶') and not CompareItem(0, ItemIndex, '丹麦人')) or
(CompareItem(1, ItemIndex, '牛奶') and not (ItemIndex = 2)) then
Result:=False;
end;
2:
begin
if (CompareItem(2, ItemIndex, '绿色') and not CompareItem(1, ItemIndex, '咖啡')) or
(CompareItem(2, ItemIndex, '红色') and not CompareItem(0, ItemIndex, '英国人')) or
(CompareItem(2, ItemIndex, '绿色') and not CompareItem(2, ItemIndex + 1, '白色')) or
(CompareItem(2, ItemIndex, '蓝色') and
not (CompareItem(0,ItemIndex + 1, '挪威人') or
CompareItem(0, ItemIndex - 1, '挪威人'))) then
Result:=False;
end;
3:
begin
if CompareItem(3, ItemIndex, 'Dunhill') and not CompareItem(2, ItemIndex, '黄色') or
CompareItem(3, ItemIndex, 'Prince') and not CompareItem(0, ItemIndex, '德国人') or
CompareItem(3, ItemIndex, 'Blue Master') and not CompareItem(1, ItemIndex, '啤酒') or
CompareItem(3, ItemIndex, 'Blends') and
not (CompareItem(1, ItemIndex + 1, '水') or
CompareItem(1, ItemIndex - 1, '水')) then
Result:=False;
end;
4:
begin
if CompareItem(4, ItemIndex, '狗') and not CompareItem(0, ItemIndex, '瑞典人') or
CompareItem(4, ItemIndex, '鸟') and not CompareItem(3, ItemIndex, 'Pall Mall') or
CompareItem(4, ItemIndex, '猫') and not (CompareItem(3, ItemIndex + 1, 'Blends') or
CompareItem(3, ItemIndex - 1, 'Blends')) or
CompareItem(4, ItemIndex, '马') and not (CompareItem(3, ItemIndex + 1, 'Dunhill') or
CompareItem(3, ItemIndex - 1, 'Dunhill')) then
Result:=False;
end;
end; //case end
if Result = False then
Exit;
end; //for end
end;
//打印结果
procedure PrintResult;
var
i, j: integer;
S: string;
begin
for j := 0 to 4 do
begin
for i := 0 to 4 do
begin
S := S + InfoArray[i, Matrix[i, j]] + ',';
end;
S := S + #13#10;
end;
form1.Memo1.Lines.Add(S);
end;
procedure FillMatrix(ItemIndex,InfoID:integer);
var
i: integer;
begin
inc(count_pro);
// 信息共五项，依次为 国家 饮料 色彩 香烟 宠物
// 用InfoID表示并定义为0-4, ItemIndex 表示每项信息的值
if ItemIndex > MatrixColCount then //如果这个信息所有的信息项全部用完
begin
if not AccordWithLogic(InfoID) then
//如果本次信息填充结果不能通过逻辑判定，则退出进行下一次填充
Exit;
if InfoID = MatrixRowCount then
//如果填充完了所有信息，则显示结果后退出,否则填充下一个信息
begin
PrintResult;
inc(count_get);
Exit;
end else
FillMatrix(0, InfoID + 1);
end;
for i := 0 to MatrixColCount do
begin
if (used[InfoID, i] = 0) then // 如果第i个元素未用过
begin
used[InfoID, i] := 1; // 使用第i个元素，作上已用标记，目的是使以后该元素不可用
Matrix[InfoID, ItemIndex] := i; // 保存当前搜索到的第i个元素到表格
FillMatrix(ItemIndex + 1, InfoID); // 递归搜索
used[InfoID, i] := 0; // 恢复递归前的值，目的是使以后该元素可用
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
count_get := 0;
count_pro := 0;
FillMatrix(0, 0);
label1.Caption := inttostr(count_get) + ' ' + inttostr(count_pro);
end;
end.
源程序可以在 这里 下载。
按下按钮之后，就可以立刻得出结论：
挪威人,水,黄色,Dunhill,猫,
丹麦人,茶,蓝色,Blends,马,
英国人,牛奶,红色,Pall Mall,鸟,
德国人,咖啡,绿色,Prince,鱼,
瑞典人,啤酒,白色,Blue Master,狗,
哦，原来那个神秘的养鱼人是德国人呀！
那么去掉一个条件会不会得出正确结果呢？试试去掉“英国人不住红色房子”的逻辑再运行，马上就得到了6个相应结果，很有趣吧？
五、扩展问题
通过修改数据定义和判断逻辑我们可解决类似的问题，比如下面的这个例题：
四个高尔夫球员从左到右站成一排。每个球员都穿不同的裤子；其中一个穿着红色裤子。
紧挨Fred右边的球员穿的是蓝色裤子。
Joe是队伍中的第二位。
Bob穿的是格子花裤子。
Tom不是第一或第四位，也不穿难看的橙色裤子。
请给出这四位球员具体排列次序，他们各穿什么颜色的裤子？
修改数据定义的部分为：
Matrix :Array[0..1 , 0..3] of smallint; //表格
MatrixRowCount :integer = 1; //表格最大行数 ,即信息数
MatrixColCount :integer = 3; //表格最大列数 ,即每项信息的个数
InfoArray:Array[0..1 , 0..3] of String =(('Fred','Joe','Bob','Tom'),
('蓝色','格子','橙色','红色'));
used: Array[0..1 , 0..3] of integer; //与InfoArray对应的元素是否已用过
修改函数AccordWithLogic中的判断逻辑为：
Case InfoID of0: Begin IF CompareItem(0,ItemIndex,'Joe') And Not ( ItemIndex=1)then Result:=False; IF CompareItem(0,ItemIndex,'Tom') And Not ((ItemIndex<>0) And
(ItemIndex <>3)) then Result:=False; End;1: Begin IF (CompareItem(1,ItemIndex,'蓝色') And
Not CompareItem(0,ItemIndex-1,'Fred')) then Result:=False; IF (CompareItem(1,ItemIndex,'格子') And
Not CompareItem(0,ItemIndex,'Bob')) then Result:=False; IF CompareItem(1,ItemIndex,'橙色') And CompareItem(0,ItemIndex,'Tom')then Result:=False; End;End;
源程序可以在 这里 下载。
运行一下看看吧，是不是和你推算的结果一样呢？
Fred,橙色,
Joe,蓝色,
Tom,红色,
Bob,格子,
结束语
解决完此题，或许你会想，这和我们日常生活有什么关系呢？我们平时编程不会用到这样的问题吧。如果你确实这样想，那就错了。这种模糊条件应用，换言之是基于特定规则的应用，实际上是很广泛的，拿我们熟悉的手机来举例吧，假如你在为移动部门设计计算手机费的编程，就必须适应公司可变性极强的运作。
公司作了要求，凡是一个月打够200话费的号码，就送30元作为奖励。又过了20天，调整原来客户座机费为每月50的下调至40，如果他同时还申请的有“手机呼”的业务，则只下调至45。过了一阵子，公司又说了，如果用户发了100条短信则送额外的10条作为奖励；手机号末尾为4的用户免三个月的月租；还有手机号在6666至6699为特惠号码段，打市话免费；另外对于入虚拟网的用户，拨打其注册的亲情号只收半价，但是如果你不在本地区本优惠不存在……
如此这般，要不了多长时间，如果你使用的是传统的编程技术，代码已经变成一团乱麻了——而且代码的性能肯定也不会好，因为它要为每一个输入的订单执行各种各样的数据库查询。但是如果你使用了一个逻辑算法来计算这些规则，就可以保持代码整洁、富有条理，因为每一个定价政策可以用一个规则来描述。
总而言之，通过对这道爱因斯坦难题的求解，我们知道了解决此类问题的一般编程方法，希望这段代码对大家以后编程有所帮助。
以上代码在Windows 2000、Delphi 7下调试通过。
一、问题的提出
爱因斯坦在20世纪初出的这个谜语，题目是这样的：
1、在一条街上，有5座房子，喷了5种颜色。
2、每个房里住着不同国籍的人。
3、每个人喝不同的饮料，抽不同品牌的香烟，养不同的宠物。
提示：
1、英国人住红色房子
2、瑞典人养狗
3、丹麦人喝茶
4、绿色房子在白色房子左面
5、绿色房子主人喝咖啡
6、抽Pall Mall香烟的人养鸟
7、黄色房子主人抽Dunhill香烟
8、住在中间房子的人喝牛奶
9、挪威人住第一间房
10、抽Blends香烟的人住在养猫的人隔壁
11、养马的人住在抽Dunhill香烟的人隔壁
12、抽Blue Master的人喝啤酒
13、德国人抽Prince香烟
14、挪威人住蓝色房子隔壁
15、抽Blends香烟的人有一个喝水的邻居
问题是：谁养鱼？
据说，98%的人答不出这道题！
二、分析
这是一道很典型的逻辑推理题，对于此题使用表格方法，通过假设找出矛盾，从而得到正确答案，是比较快速的方法，但即使是这样我见到的最快解出此题的人也用了十几分钟，那么电脑需要多久呢？答案是不到一秒钟！
如果让电脑完全按人类的推理来进行工作，那恐怕代码要写非常长，而且对于以后遇到类似的问题几乎没有什么参考价值。我们可以采用表格法进行递归穷举，利用电脑的强大的计算能力加上一些不复杂的逻辑来实现它，但是对于5!的5次方超过248亿个可能性，计算量相当的惊人。而采用按“国籍”、“饮料”、“色彩”、“香烟”、“宠物”五项信息依次对表格进行可能性填充，一旦不符合逻辑条件则立即中止向后面的信息进行判断，这样就可大大减少运算次数。
三、设计
我们将使用二维数组InfoArray实现对各信息的初始化，二维数组矩阵Matrix记录表格定义，数组used来存贮与之对应的信息选项是否已用过。AccordWithLogic函数判断是否符合命题逻辑，可以对命题的条件先作一下整理再按信息类别依次来判断，而且输入条件不能涉及到未填充的信息。例如：当前才填充到“饮料”信息就不能去判断涉及到“香烟”的第15个条件，因为还没有向表格中填充任何香烟，那么得出的判断结果是不正确的。FillMatrix函数是程序的主体，它以递归的方式列举了所有的排列可能性。PrintResult函数用于打印结果。
整个代码是一个大循环，使用了backtracing的设计思想。
四、Delphi代码实现
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button4: TButton;
Label1: TLabel;
Label3: TLabel;
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
Matrix: array[0..4 , 0..4] of smallint; //表格
MatrixRowCount: integer = 4; //表格最大行数 ,即信息数
MatrixColCount: integer = 4; //表格最大列数 ,即每项信息的个数
// 实现对各信息的初始化
InfoArray: array[0..4, 0..4] of string =(('挪威人', '英国人', '瑞典人', '丹麦人', '德国人'),
('茶', '咖啡', '牛奶', '啤酒', '水'),
('红色', '绿色', '黄色', '蓝色', '白色'),
('Prince', 'Pall Mall', 'Dunhill', 'Blends', 'Blue Master'),
('狗', '鸟', '马', '猫', '鱼'));
used: array[0..4 , 0..4] of integer; //与InfoArray对应的元素是否已用过
count_get, count_pro: integer; //结果的个数、共进行了多少次递归运算
// 取得信息号和项目序号所对应的值并和给定值进行对比
function CompareItem(InfoID, ItemIndex: Integer; CompareText: string): Boolean;
begin
if (ItemIndex <= MatrixColCount) and (ItemIndex >= 0) then
Result := InfoArray[InfoID, Matrix[InfoID, ItemIndex]] = CompareText
else
Result := False;
end;
// 采用按'国籍'、'饮料'、'色彩'、'香烟'、'宠物'
// 五项信息依次对已生成的序列进行逻辑判断
function AccordWithLogic(InfoID: integer): boolean;
var
ItemIndex: Integer;
begin
Result := True;
for ItemIndex := 0 to 4 do
begin
case InfoID of
0:
begin
if CompareItem(0, ItemIndex, '挪威人') and not (ItemIndex = 0) then
Result := False;
end;
1:
begin
if (CompareItem(1, ItemIndex, '茶') and not CompareItem(0, ItemIndex, '丹麦人')) or
(CompareItem(1, ItemIndex, '牛奶') and not (ItemIndex = 2)) then
Result:=False;
end;
2:
begin
if (CompareItem(2, ItemIndex, '绿色') and not CompareItem(1, ItemIndex, '咖啡')) or
(CompareItem(2, ItemIndex, '红色') and not CompareItem(0, ItemIndex, '英国人')) or
(CompareItem(2, ItemIndex, '绿色') and not CompareItem(2, ItemIndex + 1, '白色')) or
(CompareItem(2, ItemIndex, '蓝色') and
not (CompareItem(0,ItemIndex + 1, '挪威人') or
CompareItem(0, ItemIndex - 1, '挪威人'))) then
Result:=False;
end;
3:
begin
if CompareItem(3, ItemIndex, 'Dunhill') and not CompareItem(2, ItemIndex, '黄色') or
CompareItem(3, ItemIndex, 'Prince') and not CompareItem(0, ItemIndex, '德国人') or
CompareItem(3, ItemIndex, 'Blue Master') and not CompareItem(1, ItemIndex, '啤酒') or
CompareItem(3, ItemIndex, 'Blends') and
not (CompareItem(1, ItemIndex + 1, '水') or
CompareItem(1, ItemIndex - 1, '水')) then
Result:=False;
end;
4:
begin
if CompareItem(4, ItemIndex, '狗') and not CompareItem(0, ItemIndex, '瑞典人') or
CompareItem(4, ItemIndex, '鸟') and not CompareItem(3, ItemIndex, 'Pall Mall') or
CompareItem(4, ItemIndex, '猫') and not (CompareItem(3, ItemIndex + 1, 'Blends') or
CompareItem(3, ItemIndex - 1, 'Blends')) or
CompareItem(4, ItemIndex, '马') and not (CompareItem(3, ItemIndex + 1, 'Dunhill') or
CompareItem(3, ItemIndex - 1, 'Dunhill')) then
Result:=False;
end;
end; //case end
if Result = False then
Exit;
end; //for end
end;
//打印结果
procedure PrintResult;
var
i, j: integer;
S: string;
begin
for j := 0 to 4 do
begin
for i := 0 to 4 do
begin
S := S + InfoArray[i, Matrix[i, j]] + ',';
end;
S := S + #13#10;
end;
form1.Memo1.Lines.Add(S);
end;
procedure FillMatrix(ItemIndex,InfoID:integer);
var
i: integer;
begin
inc(count_pro);
// 信息共五项，依次为 国家 饮料 色彩 香烟 宠物
// 用InfoID表示并定义为0-4, ItemIndex 表示每项信息的值
if ItemIndex > MatrixColCount then //如果这个信息所有的信息项全部用完
begin
if not AccordWithLogic(InfoID) then
//如果本次信息填充结果不能通过逻辑判定，则退出进行下一次填充
Exit;
if InfoID = MatrixRowCount then
//如果填充完了所有信息，则显示结果后退出,否则填充下一个信息
begin
PrintResult;
inc(count_get);
Exit;
end else
FillMatrix(0, InfoID + 1);
end;
for i := 0 to MatrixColCount do
begin
if (used[InfoID, i] = 0) then // 如果第i个元素未用过
begin
used[InfoID, i] := 1; // 使用第i个元素，作上已用标记，目的是使以后该元素不可用
Matrix[InfoID, ItemIndex] := i; // 保存当前搜索到的第i个元素到表格
FillMatrix(ItemIndex + 1, InfoID); // 递归搜索
used[InfoID, i] := 0; // 恢复递归前的值，目的是使以后该元素可用
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
count_get := 0;
count_pro := 0;
FillMatrix(0, 0);
label1.Caption := inttostr(count_get) + ' ' + inttostr(count_pro);
end;
end.
源程序可以在 这里 下载。
按下按钮之后，就可以立刻得出结论：
挪威人,水,黄色,Dunhill,猫,
丹麦人,茶,蓝色,Blends,马,
英国人,牛奶,红色,Pall Mall,鸟,
德国人,咖啡,绿色,Prince,鱼,
瑞典人,啤酒,白色,Blue Master,狗,
哦，原来那个神秘的养鱼人是德国人呀！
那么去掉一个条件会不会得出正确结果呢？试试去掉“英国人不住红色房子”的逻辑再运行，马上就得到了6个相应结果，很有趣吧？
五、扩展问题
通过修改数据定义和判断逻辑我们可解决类似的问题，比如下面的这个例题：
四个高尔夫球员从左到右站成一排。每个球员都穿不同的裤子；其中一个穿着红色裤子。
紧挨Fred右边的球员穿的是蓝色裤子。
Joe是队伍中的第二位。
Bob穿的是格子花裤子。
Tom不是第一或第四位，也不穿难看的橙色裤子。
请给出这四位球员具体排列次序，他们各穿什么颜色的裤子？
修改数据定义的部分为：
Matrix :Array[0..1 , 0..3] of smallint; //表格
MatrixRowCount :integer = 1; //表格最大行数 ,即信息数
MatrixColCount :integer = 3; //表格最大列数 ,即每项信息的个数
InfoArray:Array[0..1 , 0..3] of String =(('Fred','Joe','Bob','Tom'),
('蓝色','格子','橙色','红色'));
used: Array[0..1 , 0..3] of integer; //与InfoArray对应的元素是否已用过
修改函数AccordWithLogic中的判断逻辑为：
Case InfoID of0: Begin IF CompareItem(0,ItemIndex,'Joe') And Not ( ItemIndex=1)then Result:=False; IF CompareItem(0,ItemIndex,'Tom') And Not ((ItemIndex<>0) And
(ItemIndex <>3)) then Result:=False; End;1: Begin IF (CompareItem(1,ItemIndex,'蓝色') And
Not CompareItem(0,ItemIndex-1,'Fred')) then Result:=False; IF (CompareItem(1,ItemIndex,'格子') And
Not CompareItem(0,ItemIndex,'Bob')) then Result:=False; IF CompareItem(1,ItemIndex,'橙色') And CompareItem(0,ItemIndex,'Tom')then Result:=False; End;End;
源程序可以在 这里 下载。
运行一下看看吧，是不是和你推算的结果一样呢？
Fred,橙色,
Joe,蓝色,
Tom,红色,
Bob,格子,
结束语
解决完此题，或许你会想，这和我们日常生活有什么关系呢？我们平时编程不会用到这样的问题吧。如果你确实这样想，那就错了。这种模糊条件应用，换言之是基于特定规则的应用，实际上是很广泛的，拿我们熟悉的手机来举例吧，假如你在为移动部门设计计算手机费的编程，就必须适应公司可变性极强的运作。
公司作了要求，凡是一个月打够200话费的号码，就送30元作为奖励。又过了20天，调整原来客户座机费为每月50的下调至40，如果他同时还申请的有“手机呼”的业务，则只下调至45。过了一阵子，公司又说了，如果用户发了100条短信则送额外的10条作为奖励；手机号末尾为4的用户免三个月的月租；还有手机号在6666至6699为特惠号码段，打市话免费；另外对于入虚拟网的用户，拨打其注册的亲情号只收半价，但是如果你不在本地区本优惠不存在……
如此这般，要不了多长时间，如果你使用的是传统的编程技术，代码已经变成一团乱麻了——而且代码的性能肯定也不会好，因为它要为每一个输入的订单执行各种各样的数据库查询。但是如果你使用了一个逻辑算法来计算这些规则，就可以保持代码整洁、富有条理，因为每一个定价政策可以用一个规则来描述。
总而言之，通过对这道爱因斯坦难题的求解，我们知道了解决此类问题的一般编程方法，希望这段代码对大家以后编程有所帮助。
以上代码在Windows 2000、Delphi 7下调试通过。
回复Comments
作者:
{commentrecontent}