A Nondeterministic Engine written in VB.NET 2010
- by neil chen
When I'm reading SICP (Structure and Interpretation of Computer Programs) recently, I'm very interested in the concept of an "Nondeterministic Algorithm". According to wikipedia:
In computer science, a nondeterministic algorithm is an algorithm with one or more choice points where multiple different continuations are possible, without any specification of which one will be taken.
For example, here is an puzzle came from the SICP:
Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment housethat contains only five floors. Baker does not live on the top floor. Cooper does not live onthe bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives ona higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's.Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live?
After reading this I decided to build a simple nondeterministic calculation engine with .NET. The rough idea is that we can use an iterator to track each set of possible values of the parameters, and then we implement some logic inside the engine to automate the statemachine, so that we can try one combination of the values, then test it, and then move to the next. We also used a backtracking algorithm to go back when we are running out of choices at some point.
Following is the core code of the engine itself:
Code highlighting produced by Actipro CodeHighlighter (freeware)http://www.CodeHighlighter.com/--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 <> count Then Throw New Exception("Parameter count does not match.") End If End Sub Public Property IterationOver As Boolean Private _firstTime As Boolean = True Public ReadOnly Property Current As Dictionary(Of String, Object) Get If IterationOver Then Return Nothing Else Dim _nextResult = New Dictionary(Of String, Object) For Each item In _paramDict Dim iter = item.Item2 _nextResult.Add(item.Item1, iter.Current) Next Return _nextResult End If End Get End Property Function MoveNext() As Boolean If IterationOver Then Return False End If If _firstTime Then For Each item In _paramDict Dim iter = item.Item2 iter.MoveNext() Next _firstTime = False Return True Else Dim canMoveNext = False Dim iterIndex = _paramDict.Count - 1 canMoveNext = _paramDict(iterIndex).Item2.MoveNext If canMoveNext Then Return True End If Do While Not canMoveNext iterIndex = iterIndex - 1 If iterIndex = -1 Then Return False IterationOver = True End If canMoveNext = _paramDict(iterIndex).Item2.MoveNext If canMoveNext Then For i = iterIndex + 1 To _paramDict.Count - 1 Dim iter = _paramDict(i).Item2 iter.Reset() iter.MoveNext() Next Return True End If Loop End If End Function Function GetNextResult() As Dictionary(Of String, Object) While MoveNext() Dim result = Current If Satisfy(result) Then Return result End If End While Return Nothing End Function Function Satisfy(ByVal result As Dictionary(Of String, Object)) As Boolean For Each item In _predicateDict Dim pred = item.Item1 Select Case item.Item2.Count Case 1 Dim p1 = DirectCast(pred, Func(Of Object, Boolean)) Dim v1 = result(item.Item2(0)) If Not p1(v1) Then Return False End If Case 2 Dim p2 = DirectCast(pred, Func(Of Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) If Not p2(v1, v2) Then Return False End If Case 3 Dim p3 = DirectCast(pred, Func(Of Object, Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) Dim v3 = result(item.Item2(2)) If Not p3(v1, v2, v3) Then Return False End If Case 4 Dim p4 = DirectCast(pred, Func(Of Object, Object, Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) Dim v3 = result(item.Item2(2)) Dim v4 = result(item.Item2(3)) If Not p4(v1, v2, v3, v4) Then Return False End If Case 5 Dim p5 = DirectCast(pred, Func(Of Object, Object, Object, Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) Dim v3 = result(item.Item2(2)) Dim v4 = result(item.Item2(3)) Dim v5 = result(item.Item2(4)) If Not p5(v1, v2, v3, v4, v5) Then Return False End If Case 6 Dim p6 = DirectCast(pred, Func(Of Object, Object, Object, Object, Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) Dim v3 = result(item.Item2(2)) Dim v4 = result(item.Item2(3)) Dim v5 = result(item.Item2(4)) Dim v6 = result(item.Item2(5)) If Not p6(v1, v2, v3, v4, v5, v6) Then Return False End If Case 7 Dim p7 = DirectCast(pred, Func(Of Object, Object, Object, Object, Object, Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) Dim v3 = result(item.Item2(2)) Dim v4 = result(item.Item2(3)) Dim v5 = result(item.Item2(4)) Dim v6 = result(item.Item2(5)) Dim v7 = result(item.Item2(6)) If Not p7(v1, v2, v3, v4, v5, v6, v7) Then Return False End If Case 8 Dim p8 = DirectCast(pred, Func(Of Object, Object, Object, Object, Object, Object, Object, Object, Boolean)) Dim v1 = result(item.Item2(0)) Dim v2 = result(item.Item2(1)) Dim v3 = result(item.Item2(2)) Dim v4 = result(item.Item2(3)) Dim v5 = result(item.Item2(4)) Dim v6 = result(item.Item2(5)) Dim v7 = result(item.Item2(6)) Dim v8 = result(item.Item2(7)) If Not p8(v1, v2, v3, v4, v5, v6, v7, v8) Then Return False End If Case Else Throw New NotSupportedException End Select Next Return True End FunctionEnd Class
And now we can use the engine to solve the problem we mentioned above:
Code highlighting produced by Actipro CodeHighlighter (freeware)http://www.CodeHighlighter.com/--Sub Test2() Dim engine = New NonDeterministicEngine() engine.AddParam("baker", {1, 2, 3, 4, 5}) engine.AddParam("cooper", {1, 2, 3, 4, 5}) engine.AddParam("fletcher", {1, 2, 3, 4, 5}) engine.AddParam("miller", {1, 2, 3, 4, 5}) engine.AddParam("smith", {1, 2, 3, 4, 5}) engine.AddRequire(Function(baker) As Boolean Return baker <> 5 End Function, {"baker"}) engine.AddRequire(Function(cooper) As Boolean Return cooper <> 1 End Function, {"cooper"}) engine.AddRequire(Function(fletcher) As Boolean Return fletcher <> 1 And fletcher <> 5 End Function, {"fletcher"}) engine.AddRequire(Function(miller, cooper) As Boolean 'Return miller = cooper + 1 Return miller > cooper End Function, {"miller", "cooper"}) engine.AddRequire(Function(smith, fletcher) As Boolean Return smith <> fletcher + 1 And smith <> fletcher - 1 End Function, {"smith", "fletcher"}) engine.AddRequire(Function(fletcher, cooper) As Boolean Return fletcher <> cooper + 1 And fletcher <> cooper - 1 End Function, {"fletcher", "cooper"}) engine.AddRequire(Function(a, b, c, d, e) As Boolean Return a <> b And a <> c And a <> d And a <> e And b <> c And b <> d And b <> e And c <> d And c <> e And d <> e 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
Also, this engine can solve the classic 8 queens puzzle and find out all 92 results for me.
Code highlighting produced by Actipro CodeHighlighter (freeware)http://www.CodeHighlighter.com/--Sub Test3() ' The 8-Queens problem. Dim engine = New NonDeterministicEngine() ' Let's assume that a - h represents the queens in row 1 to 8, then we just need to find out the column number for each of them. 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 a <> b AndAlso a <> c AndAlso a <> d AndAlso a <> e AndAlso a <> f AndAlso a <> g AndAlso a <> h AndAlso b <> c AndAlso b <> d AndAlso b <> e AndAlso b <> f AndAlso b <> g AndAlso b <> h AndAlso c <> d AndAlso c <> e AndAlso c <> f AndAlso c <> g AndAlso c <> h AndAlso d <> e AndAlso d <> f AndAlso d <> g AndAlso d <> h AndAlso e <> f AndAlso e <> g AndAlso e <> h AndAlso f <> g AndAlso f <> h AndAlso g <> h 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
(Chinese version of the post: http://www.cnblogs.com/RChen/archive/2010/05/17/1737587.html)
Cheers,
