快捷搜索:

用 VB.NET 实现的非确定性计算例子

读 SICP 时,不停对非确定性谋略对照感兴趣,本日终于有光阴做了一个例子。发明用自动回溯的思惟是可以很简单的实现的,呵呵。这个解法的代码还不完整,有很多缺陷,然则基础上可以阐明问题了。

所谓的非确定性谋略的典典范子是“爱因斯坦谜题”,比如这个:

贝克、库伯、弗莱舍、米勒和斯麦尔住在一个五层公寓楼的不合层,贝克不住在顶层,库伯不住在底层,弗莱舍不住在顶层

也不住在底层。米勒住的比库伯高,斯麦尔不住在弗莱舍相邻的层,弗莱舍不住在库伯相邻的层。讨教他们各住在哪层?

(SICP Page 290).

(原书题目论述有误:“米勒住的比库伯高一层” 应该是 “米勒住的比库伯高“)。

(注:开拓情况 Visual Studio 2010)

核心实现:

Public Class NonDeterministicEngine

Private _paramDict As New List(Of Tuple(Of String, IEnumerator))

'Private _predicateDict As New List(Of Tuple(Of Func(Of Object, Boolean), IEnumerable(Of String)))

Private _predicateDict As New List(Of Tuple(Of Object, IList(Of String)))

Public Sub AddParam(ByVal name As String, ByVal values As IEnumerable)

_paramDict.Add(New Tuple(Of String, IEnumerator)(name, values.GetEnumerator()))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(1, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(2, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(3, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(4, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Object, Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(5, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Object, Object, Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(6, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Object, Object, Object, Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(7, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Public Sub AddRequire(ByVal predicate As Func(Of Object, Object, Object, Object, Object, Object, Object, Object, Boolean), ByVal paramNames As IList(Of String))

CheckParamCount(8, paramNames)

_predicateDict.Add(New Tuple(Of Object, IList(Of String))(predicate, paramNames))

End Sub

Sub CheckParamCount(ByVal count As Integer, ByVal paramNames As IList(Of String))

If paramNames.Count

下面是测试代码:

(更新:增添了八皇后问题的解法,能求出所有92个解)

Module Module1

Sub Main()

Test1()

Console.WriteLine("====================================================")

Test2()

Console.WriteLine("====================================================")

Test3()

Console.ReadLine()

End Sub

Sub Test1()

Dim engine = New NonDeterministicEngine()

engine.AddParam("a", {1, 2, 3, 4, 5, 6})

engine.AddParam("b", {1, 2, 3, 4, 5, 6, 7, 8, 9, 10})

engine.AddRequire(Function(a) As Boolean

Return a > 2 AndAlso a5 AndAlso b5

End Function, {"baker"})

engine.AddRequire(Function(cooper) As Boolean

Return cooper1 And fletchercooper

End Function, {"miller", "cooper"})

engine.AddRequire(Function(smith, fletcher) As Boolean

Return smithfletcher - 1

End Function, {"smith", "fletcher"})

engine.AddRequire(Function(fletcher, cooper) As Boolean

Return fletchercooper - 1

End Function, {"fletcher", "cooper"})

engine.AddRequire(Function(a, b, c, d, e) As Boolean

Return ac And ae And bd And bd And ce

End Function, {"baker", "cooper", "fletcher", "miller", "smith"})

Dim result = engine.GetNextResult()

While Not result Is Nothing

Console.WriteLine(String.Format("baker: {0}, cooper: {1}, fletcher: {2}, miller: {3}, smith: {4}",

result("baker"),

result("cooper"),

result("fletcher"),

result("miller"),

result("smith")))

result = engine.GetNextResult()

End While

Console.WriteLine("Calculation ended.")

End Sub

Sub Test3()

' 八皇后问题的解法

Dim engine = New NonDeterministicEngine()

' 设 a - h 分手代表第 1 - 8 行上的皇后,则只要对每个皇后求出对应的列号即可。

engine.AddParam("a", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("b", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("c", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("d", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("e", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("f", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("g", {1, 2, 3, 4, 5, 6, 7, 8})

engine.AddParam("h", {1, 2, 3, 4, 5, 6, 7, 8})

' 反省是否在同一个斜线上

Dim NotInTheSameDiagonalLine = Function(cols As IList) As Boolean

For i = 0 To cols.Count - 2

For j = i + 1 To cols.Count - 1

If j - i = Math.Abs(cols(j) - cols(i)) Then

Return False

End If

Next

Next

Return True

End Function

engine.AddRequire(Function(a, b, c, d, e, f, g, h) As Boolean

Return ac AndAlso ae AndAlso ag AndAlso ac AndAlso be AndAlso bg AndAlso bd AndAlso cf AndAlso ch AndAlso df AndAlso dh AndAlso eg AndAlso eg AndAlso fh AndAlso NotInTheSameDiagonalLine({a, b, c, d, e, f, g, h})

End Function,

{"a", "b", "c", "d", "e", "f", "g", "h"})

Dim result = engine.GetNextResult()

While Not result Is Nothing

Console.WriteLine("(1,{0}), (2,{1}), (3,{2}), (4,{3}), (5,{4}), (6,{5}), (7,{6}), (8,{7})",

result("a"),

result("b"),

result("c"),

result("d"),

result("e"),

result("f"),

result("g"),

result("h"))

result = engine.GetNextResult()

End While

Console.WriteLine("Calculation ended.")

End Sub

End Module

输出结果如下:

a = 5, b = 6

a = 6, b = 7

Calculation ended.

====================================================

baker: 3, cooper: 2, fletcher: 4, miller: 5, smith: 1

Calculation ended.

====================================================

(1,1), (2,5), (3,8), (4,6), (5,3), (6,7), (7,2), (8,4)

(1,1), (2,6), (3,8), (4,3), (5,7), (6,4), (7,2), (8,5)

(1,1), (2,7), (3,4), (4,6), (5,8), (6,2), (7,5), (8,3)

(1,1), (2,7), (3,5), (4,8), (5,2), (6,4), (7,6), (8,3)

(1,2), (2,4), (3,6), (4,8), (5,3), (6,1), (7,7), (8,5)

(1,2), (2,5), (3,7), (4,1), (5,3), (6,8), (7,6), (8,4)

(1,2), (2,5), (3,7), (4,4), (5,1), (6,8), (7,6), (8,3)

(1,2), (2,6), (3,1), (4,7), (5,4), (6,8), (7,3), (8,5)

(1,2), (2,6), (3,8), (4,3), (5,1), (6,4), (7,7), (8,5)

(1,2), (2,7), (3,3), (4,6), (5,8), (6,5), (7,1), (8,4)

(1,2), (2,7), (3,5), (4,8), (5,1), (6,4), (7,6), (8,3)

(1,2), (2,8), (3,6), (4,1), (5,3), (6,5), (7,7), (8,4)

(1,3), (2,1), (3,7), (4,5), (5,8), (6,2), (7,4), (8,6)

(1,3), (2,5), (3,2), (4,8), (5,1), (6,7), (7,4), (8,6)

(1,3), (2,5), (3,2), (4,8), (5,6), (6,4), (7,7), (8,1)

(1,3), (2,5), (3,7), (4,1), (5,4), (6,2), (7,8), (8,6)

(1,3), (2,5), (3,8), (4,4), (5,1), (6,7), (7,2), (8,6)

(1,3), (2,6), (3,2), (4,5), (5,8), (6,1), (7,7), (8,4)

(1,3), (2,6), (3,2), (4,7), (5,1), (6,4), (7,8), (8,5)

(1,3), (2,6), (3,2), (4,7), (5,5), (6,1), (7,8), (8,4)

(1,3), (2,6), (3,4), (4,1), (5,8), (6,5), (7,7), (8,2)

(1,3), (2,6), (3,4), (4,2), (5,8), (6,5), (7,7), (8,1)

(1,3), (2,6), (3,8), (4,1), (5,4), (6,7), (7,5), (8,2)

(1,3), (2,6), (3,8), (4,1), (5,5), (6,7), (7,2), (8,4)

(1,3), (2,6), (3,8), (4,2), (5,4), (6,1), (7,7), (8,5)

(1,3), (2,7), (3,2), (4,8), (5,5), (6,1), (7,4), (8,6)

(1,3), (2,7), (3,2), (4,8), (5,6), (6,4), (7,1), (8,5)

(1,3), (2,8), (3,4), (4,7), (5,1), (6,6), (7,2), (8,5)

(1,4), (2,1), (3,5), (4,8), (5,2), (6,7), (7,3), (8,6)

(1,4), (2,1), (3,5), (4,8), (5,6), (6,3), (7,7), (8,2)

(1,4), (2,2), (3,5), (4,8), (5,6), (6,1), (7,3), (8,7)

(1,4), (2,2), (3,7), (4,3), (5,6), (6,8), (7,1), (8,5)

(1,4), (2,2), (3,7), (4,3), (5,6), (6,8), (7,5), (8,1)

(1,4), (2,2), (3,7), (4,5), (5,1), (6,8), (7,6), (8,3)

(1,4), (2,2), (3,8), (4,5), (5,7), (6,1), (7,3), (8,6)

(1,4), (2,2), (3,8), (4,6), (5,1), (6,3), (7,5), (8,7)

(1,4), (2,6), (3,1), (4,5), (5,2), (6,8), (7,3), (8,7)

(1,4), (2,6), (3,8), (4,2), (5,7), (6,1), (7,3), (8,5)

(1,4), (2,6), (3,8), (4,3), (5,1), (6,7), (7,5), (8,2)

(1,4), (2,7), (3,1), (4,8), (5,5), (6,2), (7,6), (8,3)

(1,4), (2,7), (3,3), (4,8), (5,2), (6,5), (7,1), (8,6)

(1,4), (2,7), (3,5), (4,2), (5,6), (6,1), (7,3), (8,8)

(1,4), (2,7), (3,5), (4,3), (5,1), (6,6), (7,8), (8,2)

(1,4), (2,8), (3,1), (4,3), (5,6), (6,2), (7,7), (8,5)

(1,4), (2,8), (3,1), (4,5), (5,7), (6,2), (7,6), (8,3)

(1,4), (2,8), (3,5), (4,3), (5,1), (6,7), (7,2), (8,6)

(1,5), (2,1), (3,4), (4,6), (5,8), (6,2), (7,7), (8,3)

(1,5), (2,1), (3,8), (4,4), (5,2), (6,7), (7,3), (8,6)

(1,5), (2,1), (3,8), (4,6), (5,3), (6,7), (7,2), (8,4)

(1,5), (2,2), (3,4), (4,6), (5,8), (6,3), (7,1), (8,7)

(1,5), (2,2), (3,4), (4,7), (5,3), (6,8), (7,6), (8,1)

(1,5), (2,2), (3,6), (4,1), (5,7), (6,4), (7,8), (8,3)

(1,5), (2,2), (3,8), (4,1), (5,4), (6,7), (7,3), (8,6)

(1,5), (2,3), (3,1), (4,6), (5,8), (6,2), (7,4), (8,7)

(1,5), (2,3), (3,1), (4,7), (5,2), (6,8), (7,6), (8,4)

(1,5), (2,3), (3,8), (4,4), (5,7), (6,1), (7,6), (8,2)

(1,5), (2,7), (3,1), (4,3), (5,8), (6,6), (7,4), (8,2)

(1,5), (2,7), (3,1), (4,4), (5,2), (6,8), (7,6), (8,3)

(1,5), (2,7), (3,2), (4,4), (5,8), (6,1), (7,3), (8,6)

(1,5), (2,7), (3,2), (4,6), (5,3), (6,1), (7,4), (8,8)

(1,5), (2,7), (3,2), (4,6), (5,3), (6,1), (7,8), (8,4)

(1,5), (2,7), (3,4), (4,1), (5,3), (6,8), (7,6), (8,2)

(1,5), (2,8), (3,4), (4,1), (5,3), (6,6), (7,2), (8,7)

(1,5), (2,8), (3,4), (4,1), (5,7), (6,2), (7,6), (8,3)

(1,6), (2,1), (3,5), (4,2), (5,8), (6,3), (7,7), (8,4)

(1,6), (2,2), (3,7), (4,1), (5,3), (6,5), (7,8), (8,4)

(1,6), (2,2), (3,7), (4,1), (5,4), (6,8), (7,5), (8,3)

(1,6), (2,3), (3,1), (4,7), (5,5), (6,8), (7,2), (8,4)

(1,6), (2,3), (3,1), (4,8), (5,4), (6,2), (7,7), (8,5)

(1,6), (2,3), (3,1), (4,8), (5,5), (6,2), (7,4), (8,7)

(1,6), (2,3), (3,5), (4,7), (5,1), (6,4), (7,2), (8,8)

(1,6), (2,3), (3,5), (4,8), (5,1), (6,4), (7,2), (8,7)

(1,6), (2,3), (3,7), (4,2), (5,4), (6,8), (7,1), (8,5)

(1,6), (2,3), (3,7), (4,2), (5,8), (6,5), (7,1), (8,4)

(1,6), (2,3), (3,7), (4,4), (5,1), (6,8), (7,2), (8,5)

(1,6), (2,4), (3,1), (4,5), (5,8), (6,2), (7,7), (8,3)

(1,6), (2,4), (3,2), (4,8), (5,5), (6,7), (7,1), (8,3)

(1,6), (2,4), (3,7), (4,1), (5,3), (6,5), (7,2), (8,8)

(1,6), (2,4), (3,7), (4,1), (5,8), (6,2), (7,5), (8,3)

(1,6), (2,8), (3,2), (4,4), (5,1), (6,7), (7,5), (8,3)

(1,7), (2,1), (3,3), (4,8), (5,6), (6,4), (7,2), (8,5)

(1,7), (2,2), (3,4), (4,1), (5,8), (6,5), (7,3), (8,6)

(1,7), (2,2), (3,6), (4,3), (5,1), (6,4), (7,8), (8,5)

(1,7), (2,3), (3,1), (4,6), (5,8), (6,5), (7,2), (8,4)

(1,7), (2,3), (3,8), (4,2), (5,5), (6,1), (7,6), (8,4)

(1,7), (2,4), (3,2), (4,5), (5,8), (6,1), (7,3), (8,6)

(1,7), (2,4), (3,2), (4,8), (5,6), (6,1), (7,3), (8,5)

(1,7), (2,5), (3,3), (4,1), (5,6), (6,8), (7,2), (8,4)

(1,8), (2,2), (3,4), (4,1), (5,7), (6,5), (7,3), (8,6)

(1,8), (2,2), (3,5), (4,3), (5,1), (6,7), (7,4), (8,6)

(1,8), (2,3), (3,1), (4,6), (5,2), (6,5), (7,7), (8,4)

(1,8), (2,4), (3,1), (4,3), (5,6), (6,2), (7,7), (8,5)

Calculation ended.

转自:http://www.cnblogs.com/RChen/archive/2010/05/17/1737587.html

您可能还会对下面的文章感兴趣: