2次元ライブラリ

オセロ、将棋、五目並べ、ナンバークロスワード、ロジックパズルなどなど、世の中には多くのボードゲームがある。プログラムでこれらを実現しようとしたとき2次元座標を管理しなくてはいけない。2次元座標を管理するにはよく2次元配列が利用される。しかしボードゲームにありがちな、列や行、斜め線の走査といった処理を行う時、2次元座標では不便である。そこでボードゲームのボードを管理するクラスを作成した。

基本的な機能

作成したクラスは次の通り
・Cell(Of T) セル。x座標、y座標、セルの値を含む。
・Line(Of T) ライン。複数のセルを含む。
・Board(Of T) ボード。2次元座標を管理する。

ボードには任意のラインを抽出する機能がある。この機能を利用して、ボードオブジェクトは縦のライン、横のライン、斜めのライン(2つ)をプロパティとして最初から保持している。ラインに含まれるセルオブジェクトはボードや各ラインで共有されているので、このセルの値を書き換えると全体に反映される。

コード

セル
''' <summary>
''' セル
''' </summary>
''' <typeparam name="T"></typeparam>
''' <remarks></remarks>
Public Class Cell(Of T)

#Region "Variables"

    Private ReadOnly _x As Integer
    Private ReadOnly _y As Integer
    Private _value As T

#End Region

#Region "Properties"

    Public ReadOnly Property X() As Integer
        Get
            Return _x
        End Get
    End Property

    Public ReadOnly Property Y() As Integer
        Get
            Return _y
        End Get
    End Property

    Public Property Value() As T
        Get
            Return _value
        End Get
        Set(ByVal value As T)
            If value Is Nothing Then Throw New ArgumentNullException("val")
            Me._value = value
        End Set
    End Property

#End Region

#Region "Initialize"

    Public Sub New(ByVal value As T, ByVal x As Integer, ByVal y As Integer)

        If value Is Nothing Then Throw New ArgumentNullException("value")
        If Not 0 <= x Then Throw New ArgumentOutOfRangeException("x")
        If Not 0 <= y Then Throw New ArgumentOutOfRangeException("y")

        Me.Value = value
        Me._x = x
        Me._y = y
    End Sub

#End Region

End Class
ライン
''' <summary>
''' ライン
''' </summary>
''' <typeparam name="T"></typeparam>
''' <remarks></remarks>
Public Class Line(Of T)
    Inherits List(Of Cell(Of T))

End Class
ボード
Imports System.Collections.ObjectModel

Public Class Board(Of T)


#Region "Variables"

    Private ReadOnly _width As Integer
    Private ReadOnly _height As Integer
    Private ReadOnly _boardCells(,) As Cell(Of T)

    Private ReadOnly _verticalLines As ReadOnlyCollection(Of Line(Of T))
    Private ReadOnly _horizontalLines As ReadOnlyCollection(Of Line(Of T))
    Private ReadOnly _slashRightDownLines As ReadOnlyCollection(Of Line(Of T))
    Private ReadOnly _slashLeftDownLines As ReadOnlyCollection(Of Line(Of T))

#End Region

#Region "Properties"

    Public ReadOnly Property Width() As Integer
        Get
            Return _width
        End Get
    End Property

    Public ReadOnly Property Height() As Integer
        Get
            Return _height
        End Get
    End Property


    Default Public ReadOnly Property Item(ByVal x As Integer, ByVal y As Integer) As T
        Get
            Return GetCellValue(x, y)
        End Get
    End Property


    Public ReadOnly Property HorizontalLines() As ReadOnlyCollection(Of Line(Of T))
        Get
            Return _horizontalLines
        End Get
    End Property

    Public ReadOnly Property VerticalLines() As ReadOnlyCollection(Of Line(Of T))
        Get
            Return _verticalLines
        End Get
    End Property

    Public ReadOnly Property SlashRightDownLines() As ReadOnlyCollection(Of Line(Of T))
        Get
            Return _slashRightDownLines
        End Get
    End Property

    Public ReadOnly Property SlashLeftDownLines() As ReadOnlyCollection(Of Line(Of T))
        Get
            Return _slashLeftDownLines
        End Get
    End Property

#End Region

#Region "Initialize"

    Public Sub New(ByVal defaultType As T, ByVal width As Integer, ByVal height As Integer)

        If defaultType Is Nothing Then Throw New ArgumentNullException("val")
        If Not 0 < width Then Throw New ArgumentOutOfRangeException("width")
        If Not 0 < height Then Throw New ArgumentOutOfRangeException("height")

        Me._boardCells = New Cell(Of T)(width - 1, height - 1) {}
        Dim length As Integer = Me._boardCells.Length
        For i = 0 To length - 1
            Dim x As Integer = i Mod width
            Dim y As Integer = CInt(Math.Floor(i / width))
            Me._boardCells(x, y) = New Cell(Of T)(defaultType, x, y)
        Next

        Me._width = width
        Me._height = height
        Me._verticalLines = SelectVerticalLines()
        Me._horizontalLines = SelectHorizontalLines()
        Me._slashLeftDownLines = SelectSlashRightTopToLeftDown()
        Me._slashRightDownLines = SelectSlashLeftTopToRightDown()
    End Sub

#End Region

#Region "Private Methods"

    Protected Function SelectVerticalLines() As ReadOnlyCollection(Of Line(Of T))
        Dim startPoint As New List(Of Point)

        For x As Integer = 0 To Width - 1
            startPoint.Add(New Point(x, 0))
        Next

        Return SelectLines(startPoint, 0, 1)
    End Function

    Protected Function SelectHorizontalLines() As ReadOnlyCollection(Of Line(Of T))
        Dim startPoint As New List(Of Point)

        For y As Integer = 0 To Height - 1
            startPoint.Add(New Point(0, y))
        Next

        Return SelectLines(startPoint, 1, 0)
    End Function

    Protected Function SelectSlashRightTopToLeftDown() As ReadOnlyCollection(Of Line(Of T))
        Dim list As New List(Of Point)

        For x As Integer = 0 To Width - 1
            list.Add(New Point(x, 0))
        Next
        For y As Integer = 1 To Height - 1
            list.Add(New Point(Width - 1, y))
        Next

        Return SelectLines(list, -1, 1)
    End Function

    Protected Function SelectSlashLeftTopToRightDown() As ReadOnlyCollection(Of Line(Of T))
        Dim list As New List(Of Point)

        For x As Integer = 0 To Width - 1
            list.Add(New Point(x, 0))
        Next
        For y As Integer = 1 To Height - 1
            list.Add(New Point(0, y))
        Next

        Return SelectLines(list, 1, 1)
    End Function


    Private Function IsRangeX(ByVal x As Integer) As Boolean

        If Not 0 <= x Then Return False
        If Not x < Width Then Return False

        Return True
    End Function

    Private Function IsRangeY(ByVal y As Integer) As Boolean

        If Not 0 <= y Then Return False
        If Not y < Height Then Return False

        Return True
    End Function

    Public Function GetCell(ByVal x As Integer, ByVal y As Integer) As Cell(Of T)
        If Not IsRangeX(x) Then Throw New ArgumentOutOfRangeException("x")
        If Not IsRangeY(y) Then Throw New ArgumentOutOfRangeException("y")

        Return Me._boardCells(x, y)
    End Function

#End Region

#Region "Public Methods"

    Public Function GetCellValue(ByVal x As Integer, ByVal y As Integer) As T
        Return GetCell(x, y).Value
    End Function

    Public Sub SetCellValue(ByVal value As T, ByVal x As Integer, ByVal y As Integer)
        GetCell(x, y).Value = value
    End Sub

    Public Function SelectLines(ByVal startPointList As IEnumerable(Of Point), ByVal directionX As Integer, ByVal directionY As Integer) As ReadOnlyCollection(Of Line(Of T))
        If startPointList Is Nothing Then Throw New ArgumentNullException("startPoint")
        If directionX = 0 AndAlso directionY = 0 Then Throw New ArgumentException("directionXとdirectionYの両方を0にすることはできません。")

        Dim lineList As New List(Of Line(Of T))

        For Each p As Point In startPointList
            Dim line As Line(Of T) = SelectSingleLine(p, directionX, directionY)
            lineList.Add(line)
        Next

        Return lineList.AsReadOnly
    End Function

    Public Function SelectSingleLine(ByVal startPoint As Point, ByVal directionX As Integer, ByVal directionY As Integer) As Line(Of T)
        If Not IsRangeX(startPoint.X) Then Throw New ArgumentOutOfRangeException("startPoint.X")
        If Not IsRangeY(startPoint.Y) Then Throw New ArgumentOutOfRangeException("startPoint.Y")
        If directionX = 0 AndAlso directionY = 0 Then Throw New ArgumentException("directionXとdirectionYの両方を0にすることはできません。")

        Dim line As New Line(Of T)
        Dim cell As Cell(Of T) = GetCell(startPoint.X, startPoint.Y)
        line.Add(cell)

        While (True)

            startPoint.X = startPoint.X + directionX
            startPoint.Y = startPoint.Y + directionY

            Try
                cell = GetCell(startPoint.X, startPoint.Y)
            Catch ex As ArgumentOutOfRangeException
                Exit While
            End Try

            line.Add(cell)

        End While

        Return line
    End Function

#End Region

End Class

ライブラリは以上。

利用例

このライブラリの利用例、兼テストコード。

Public Enum MyCell
    Zero
    One
    Two
    Three
    Four
    Five
    Six
    Seven
    Eight
    Nine
End Enum
Public Class MyBoard
    Inherits Board(Of MyCell)

    Sub New()
        MyBase.New(MyCell.Zero, 3, 3)
    End Sub

End Class
Imports BoardGame
Imports System.Collections.ObjectModel

Module Module1

    Sub Main()

        Dim board As New MyBoard()

        Assert(3, board.Height)
        Assert(3, board.Width)

        board.SetCellValue(MyCell.One, 0, 0)
        board.SetCellValue(MyCell.Two, 1, 0)
        board.SetCellValue(MyCell.Three, 2, 0)
        board.SetCellValue(MyCell.Four, 0, 1)
        board.SetCellValue(MyCell.Five, 1, 1)
        board.SetCellValue(MyCell.Six, 2, 1)
        board.SetCellValue(MyCell.Seven, 0, 2)
        board.SetCellValue(MyCell.Eight, 1, 2)
        board.SetCellValue(MyCell.Nine, 2, 2)

        Assert(MyCell.One, board(0, 0))
        Assert(MyCell.Two, board(1, 0))
        Assert(MyCell.Three, board(2, 0))
        Assert(MyCell.Four, board(0, 1))
        Assert(MyCell.Five, board(1, 1))
        Assert(MyCell.Six, board(2, 1))
        Assert(MyCell.Seven, board(0, 2))
        Assert(MyCell.Eight, board(1, 2))
        Assert(MyCell.Nine, board(2, 2))


        Dim currentLineList As ReadOnlyCollection(Of Line(Of MyCell))

        '水平のライン
        currentLineList = board.VerticalLines
        Assert(3, currentLineList.Count)
        CheckSameValue(New MyCell() {MyCell.One, MyCell.Four, MyCell.Seven}, currentLineList(0))
        CheckSameValue(New MyCell() {MyCell.Two, MyCell.Five, MyCell.Eight}, currentLineList(1))
        CheckSameValue(New MyCell() {MyCell.Three, MyCell.Six, MyCell.Nine}, currentLineList(2))

        '垂直のライン
        currentLineList = board.HorizontalLines
        Assert(3, currentLineList.Count)
        CheckSameValue(New MyCell() {MyCell.One, MyCell.Two, MyCell.Three}, currentLineList(0))
        CheckSameValue(New MyCell() {MyCell.Four, MyCell.Five, MyCell.Six}, currentLineList(1))
        CheckSameValue(New MyCell() {MyCell.Seven, MyCell.Eight, MyCell.Nine}, currentLineList(2))

        '右上から左下に向けてのライン
        currentLineList = board.SlashLeftDownLines
        Assert(5, currentLineList.Count)
        CheckSameValue(New MyCell() {MyCell.One}, currentLineList(0))
        CheckSameValue(New MyCell() {MyCell.Two, MyCell.Four}, currentLineList(1))
        CheckSameValue(New MyCell() {MyCell.Three, MyCell.Five, MyCell.Seven}, currentLineList(2))
        CheckSameValue(New MyCell() {MyCell.Six, MyCell.Eight}, currentLineList(3))
        CheckSameValue(New MyCell() {MyCell.Nine}, currentLineList(4))

        '左上から右下に向けてのライン
        currentLineList = board.SlashRightDownLines
        Assert(5, currentLineList.Count)
        CheckSameValue(New MyCell() {MyCell.One, MyCell.Five, MyCell.Nine}, currentLineList(0))
        CheckSameValue(New MyCell() {MyCell.Two, MyCell.Six}, currentLineList(1))
        CheckSameValue(New MyCell() {MyCell.Three}, currentLineList(2))
        CheckSameValue(New MyCell() {MyCell.Four, MyCell.Eight}, currentLineList(3))
        CheckSameValue(New MyCell() {MyCell.Seven}, currentLineList(4))

    End Sub

    Sub Assert(Of V)(ByVal expected As V, ByVal actual As V)
        If Not expected.Equals(actual) Then
            'Dim stack As New StackFrame(0)
            'Dim point As Integer = stack.GetFileColumnNumber
            Dim msg As String = "「" & expected.ToString & "」が期待されていましたが、「" & If(actual Is Nothing, "Nothing", actual.ToString) & "」が検出されました。"
            Throw New InvalidOperationException(msg)
        End If
    End Sub

    Private Sub CheckSameValue(ByVal expected As IEnumerable(Of MyCell), ByVal actual As Line(Of MyCell))

        Assert(expected.Count, actual.Count)

        For i = 0 To expected.Count - 1
            Assert(expected(i), actual(i).Value)
        Next

    End Sub

End Module