Conway's Game Of Life

My first submission in the vb.net Challenge: Conway's Game of Life.

In my attempt I have make parallel processing version. It maxes out both my cores on my computer. Try it out on yours (does require .net 4.0 Client Profile)

---

Life Rules

RulesetBase
This base class encapsulates the basic functionality needed for the life rules.
So build on top of it different rulesets.

Public MustInherit Class RulesetBase
  MustOverride Function NextCellState(self As Boolean, ns As IEnumerable(Of Boolean)) As Boolean
End Class

An implementation of the Classic Conway rules

Public Class ConwayRuleset
  Inherits RulesetBase

  Public Overrides Function NextCellState(AliveCell As Boolean, ns As IEnumerable(Of Boolean)) As Boolean
    Dim Neighbours = ns.Count(Function(Cell) Cell)
    If AliveCell Then
      'alive cell
      If Neighbours < 2 Then Return False
      If Neighbours = 2 OrElse Neighbours = 3 Then Return True
      If Neighbours > 3 Then Return False
      Return False
    Else
      ' dead cell
      If Neighbours = 3 Then Return True
      Return False
    End If
  End Function
End Class

ConwayColors
To allow me to change the colors a used to reflect the different states of the cell.

Public Class ConwayColors
  Private _Alive As Drawing.Color
  Private _Dead As Drawing.Color
  Public Sub New(ByVal AliveCellColor As Color, DeadCellColor As Color)
    _Alive = AliveCellColor
    _Dead = DeadCellColor
  End Sub
  Public ReadOnly Property Alive As Color
    Get
      Return _Alive
    End Get
  End Property
  Public ReadOnly Property Dead As Color
    Get
      Return _Dead
    End Get
  End Property
End Class

Extension Methods

Imports System.Runtime.CompilerServices
Public Module exts
  <Extension()>
  Public Function Wrap(ByVal x As Integer, y As Integer) As Integer
    Dim m = x Mod y
    Return If(m >= 0, m, (m + y) Mod y)
  End Function

  <Extension()>
  Public Function Neighbours(conway As ConwayGame, x As Integer, y As Integer) As IEnumerable(Of Boolean)
    Return {conway((x - 1).Wrap(conway.Width), (y - 1).Wrap(conway.Height)),
            conway((x).Wrap(conway.Width), (y - 1).Wrap(conway.Height)),
            conway((x + 1).Wrap(conway.Width), (y - 1).Wrap(conway.Height)),
            conway((x - 1).Wrap(conway.Width), (y - 0).Wrap(conway.Height)),
            conway((x + 1).Wrap(conway.Width), (y).Wrap(conway.Height)),
            conway((x - 1).Wrap(conway.Width), (y + 1).Wrap(conway.Height)),
            conway((x).Wrap(conway.Width), (y + 1).Wrap(conway.Height)),
            conway((x + 1).Wrap(conway.Width), (y + 1).Wrap(conway.Height))}
  End Function
End Module

ConwayGame
This class encapsulate the functionality of the Game Of Life, generating the next states and projecting it into a bitmap. I've designed and written the class so it is Immutable, this means that generating the next states produces a completely new instance of the ConwayGame class. (In theory you can keep all of the previous states. So you could check to see if the world has locked it a periodic cyclic generations.

Option Strict On

<System.ComponentModel.ImmutableObject(True)>
Public Class ConwayGame
  Private _Ruleset As RulesetBase
  Private _Colors As ConwayColors
  Private _CellWorld(,) As Boolean
  Private _Width, _Height As Integer
  Private _AliveCellCount As Long = 0L

#Region "Private Constructor"
  Private Sub New(width As Integer, height As Integer, GovernedBy As RulesetBase, Colors As ConwayColors)
    _Width = width : _Height = height 'Set World Dimensions
    ReDim _CellWorld(_Width, _Height) ' Reshape the World
    _Ruleset = GovernedBy ' The rules that apply to this world.
    _Colors = Colors ' Set the color palette.
  End Sub
#End Region

#Region "Public Methods"
#Region "The Factory Methods"
  Public Shared Function CreateRandom(ByVal Width As Integer, Height As Integer, AliveCells As Integer, GovernedBy As RulesetBase, Colors As ConwayColors) As ConwayGame
    Return ConwayGame.Rand(New ConwayGame(Width, Height, GovernedBy, Colors), AliveCells)
  End Function

  Public Shared Function CreateNew(ByVal Width As Integer, Height As Integer, GovernedBy As RulesetBase, Colors As ConwayColors) As ConwayGame
    Return New ConwayGame(Width, Height, GovernedBy, Colors)
  End Function
#End Region
#Region "Properties"
#Region "Indexer"
  Default Public ReadOnly Property Cell(x As Integer, y As Integer) As Boolean
    Get
      x = x.Wrap(_Width)
      y = y.Wrap(_Height)
      Return _CellWorld(x, y)
    End Get
  End Property
#End Region
  Public ReadOnly Property Width As Integer
    Get
      Return Me._Width
    End Get
  End Property
  Public ReadOnly Property Height As Integer
    Get
      Return Me._Height
    End Get
  End Property
  Public ReadOnly Property Colors As ConwayColors
    Get
      Return _Colors
    End Get
  End Property
  Public ReadOnly Property AliveCellCount() As Long
    Get
      Return _AliveCellCount
    End Get
  End Property
#End Region

#Region "(Rule Stuff)"
  Public Function NextGeneration() As ConwayGame
    Dim cw = New ConwayGame(_Width, _Height, _Ruleset, _Colors)
    Dim ac As Long = 0L
    Parallel.For(0, _Height, Sub(y As Integer)
                               Parallel.For(0, _Width, Sub(x As Integer)
                                                         Dim b = _Ruleset.NextCellState(Me(x, y), Me.Neighbours(x, y))
                                                         If b Then Threading.Interlocked.Increment(ac)
                                                         cw._CellWorld(x, y) = b
                                                       End Sub)
                             End Sub)
    cw._AliveCellCount = ac
    Return cw
  End Function
#End Region

#Region "Shared amonst all Conway's"
  Private Shared Function Rand(ByRef ThisConway As ConwayGame, s As Integer) As ConwayGame
    Dim rng As New Random
    Dim x, y As Integer
    For r = 1 To s
      Do
        x = rng.Next(0, ThisConway.Width)
        y = rng.Next(0, ThisConway.Height)
      Loop Until ThisConway(x, y) = False
      ThisConway._CellWorld(x, y) = True
    Next
    Return ThisConway
  End Function
#Region "Bitmap Generation"
  Private Shared Sub ToBMP(ByVal cw As ConwayGame, ByRef ThisBMP As Bitmap)
    Dim l = cw.Width * cw.Height * 4
    Dim bmpBytes(l) As Byte
    Dim s = cw.Width * 4
    Parallel.For(0, cw.Height, Sub(y)
                                 Dim ys = s * y
                                 Parallel.For(0, cw.Width, Sub(X)
                                                             Dim c = If(cw(X, y), cw.Colors.Alive, cw.Colors.Dead)
                                                             Dim p = ys + (4 * X)
                                                             bmpBytes(p + 0) = c.B
                                                             bmpBytes(p + 1) = c.G
                                                             bmpBytes(p + 2) = c.R
                                                             bmpBytes(p + 3) = 255
                                                           End Sub)
                                End Sub)
    ThisBMP = New Bitmap(cw.Width, cw.Height, Imaging.PixelFormat.Format32bppArgb)

    Dim bmpData = ThisBMP.LockBits(New Rectangle(0, 0, cw.Width, cw.Height), Imaging.ImageLockMode.WriteOnly, Imaging.PixelFormat.Format32bppArgb)
    '  Copy the bytes over to the bitmap
    System.Runtime.InteropServices.Marshal.Copy(bmpBytes, 0, bmpData.Scan0, l)
    ThisBMP.UnlockBits(bmpData)
  End Sub
  Public Shared Function ToBitmap(ThisConway As ConwayGame) As Bitmap
    Dim ThisBMP As Bitmap = Nothing ' As New Bitmap(ThisConway.Width, ThisConway.Height)
    ConwayGame.ToBMP(ThisConway, ThisBMP)
    Return ThisBMP
  End Function
#End Region
#End Region

  #End Region

End Class

---

The UI

Imports System.Threading.Tasks
Imports System.Linq
Public Class Form1
  Dim cw As ConwayGame
  Dim rules As New ConwayRuleset
  Dim colors As New ConwayColors(Color.Black, Color.White)

  Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    cw = ConwayGame.CreateRandom(640, 480, 20000, rules, colors)
    'cw = ConwayGame.CreateRandom(320, 240, 10000, rules, colors)
    'cw = ConwayGame.CreateRandom(100, 100, 250,rules,colors)
    Dim c = cw.AliveCellCount()
    Me.WorldPic.Image = ConwayGame.ToBitmap(cw)
    StartButton.Text = "Start"
    StartButton.ForeColor = Color.Green
640:
  End Sub

  Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles HeartBeat.Tick
    UpdateWorld()
  End Sub

  Private Sub UpdateWorld()
    cw = cw.NextGeneration()
    DisplayWorldBitmap()
    AliveCellCount_Lbl.Text = cw.AliveCellCount
  End Sub



  Private Sub StartButton_Click(sender As Object, e As EventArgs) Handles StartButton.Click
    If HeartBeat.Enabled Then
      HeartBeat.Enabled = False
      StartButton.Text = "Start"
      StartButton.ForeColor = Color.Green
      RndButton.Enabled = True

    Else
      HeartBeat.Enabled = True
      StartButton.Text = "Stop"
      StartButton.ForeColor = Color.Red
      RndButton.Enabled = False


    End If
  End Sub
  Private Sub RndButton_Click(sender As Object, e As EventArgs) Handles RndButton.Click
    cw = ConwayGame.CreateRandom(640, 480, 20000, rules, colors)
    DisplayWorldBitmap()
  End Sub
  Private Sub DisplayWorldBitmap()
    Me.WorldPic.Image = ConwayGame.ToBitmap(cw)

  End Sub
End Class

Project Zip:  CONWAY~1.zip (18.46K)
Number of downloads: 236