A Nondeterministic Engine written in VB.NET 2010

Posted by neil chen on ASP.net Weblogs See other posts from ASP.net Weblogs or by neil chen
Published on Tue, 18 May 2010 06:54:00 GMT Indexed on 2010/05/18 8:21 UTC
Read the original article Hit count: 787

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 house
that contains only five floors. Baker does not live on the top floor. Cooper does not live on
the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on
a 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:

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 Function
End Class


 

 
And now we can use the engine to solve the problem we mentioned above:

 

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.

 

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,

 

© ASP.net Weblogs or respective owner

Related posts about Visual Studio 2010

Related posts about Visual Basic