none
Puzzle Generator - Need some hints RRS feed

  • General discussion

  • I am working on some number puzzles known as "NumBrix" - basically a 9x9 grid of squares that need to be filled in with the numbers 1 to 81, in order, no duplicates. The only rules is that the "next" number must be adjacent to the "previous" number in a straight line, no diagonals. I'm trying to generate them randomly and the code I have so far (below) always paints itself into an impossible scenario as in the picture below the code. Any ideas on how to lessen that would be great.
    Code, just paste into a new Windows Forms Project :

    Option Strict On
    Public Class Form1
        Private RNG As New Random
        Private TextSquares As New List(Of TextBox)
        Private WithEvents BtnStart As New Button With {.Top = 0, .Left = 0, .Text = "Start"}
        Private LastNumber As Integer = 1
    
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            For TB = 0 To 80
                TextSquares.Add(New TextBox With {.Width = 60, .Height = 50, .TextAlign = HorizontalAlignment.Center, .ForeColor = Color.Black, .BackColor = Color.White,
                                                  .ShortcutsEnabled = False, .Tag = TB.ToString, .Left = 10 + (61 * (TB Mod 9)), .[ReadOnly] = True,
                                                  .Top = 60 + (47 * (TB \ 9)), .Font = New Font("Consolas", 24)})
            Next
            For Each TB As TextBox In TextSquares
                Me.Controls.Add(TB)
            Next
            Me.Controls.Add(BtnStart)
            Me.Size = New Size(585, 555)
        End Sub
    
        Private Sub BtnClearStart_Click(sender As Object, e As EventArgs) Handles BtnStart.Click
            Dim CurrentRow As Integer = 0
            Dim CurrentCol As Integer = 0
            Dim OffsetIndex As Integer = 0
            Dim XOffset As Integer = 0
            Dim YOffset As Integer = 0
            Dim NewRow As Integer = 0
            Dim NewCol As Integer = 0
            Dim NewIndex As Integer = 0
            Dim Offsets() As String = Nothing
            Dim Success As Boolean = False
            Dim MoveOK As Boolean = False
            Dim TriesToMove As Integer = 0
            For TB = 0 To 80
                TextSquares(TB).Clear()
                LastNumber = 1
            Next
            Dim Choices As New List(Of String) 'String with what to add to columm, then row for each possibke direction
            Choices.Add("1,0")  'Right
            Choices.Add("-1,0") 'Left
            Choices.Add("0,-1") 'Up
            Choices.Add("0,1")  'Down
            Dim Tries As Integer = 0
            Dim CurrentBox As Integer = RNG.Next(0, 80)
            TextSquares(CurrentBox).Text = LastNumber.ToString
            LastNumber += 1
            For Attempts = 1 To 200
                Tries = 0
                Do
                    MoveOK = False
                    TriesToMove = 0
                    Do
                        TriesToMove = 0
                        OffsetIndex = RNG.Next(0, 4)
                        Offsets = Choices(OffsetIndex).Split(",".ToCharArray)
                        XOffset = CInt(Offsets(0))
                        YOffset = CInt(Offsets(1))
                        CurrentRow = CurrentBox \ 9
                        CurrentCol = CurrentBox Mod 9
                        NewCol = CurrentCol + XOffset
                        NewRow = CurrentRow + YOffset
                        If NewCol >= 0 AndAlso NewCol <= 8 AndAlso NewRow >= 0 AndAlso NewRow <= 8 Then MoveOK = True
                    Loop Until MoveOK = True Or TriesToMove > 50
                    If TriesToMove > 50 Then
                        Success = False
                        Exit For
                    End If
                    NewIndex = (NewRow * 9) + NewCol
                    If NewIndex < 0 Or NewIndex > 80 Then
                        Success = False
                    Else
                        Success = True
                    End If
                    If Success = True Then
                        If TextSquares(NewIndex).Text <> "" Then
                            Success = False
                        End If
                    End If
                    Tries += 1
                Loop Until Success = True Or Tries > 50
                If Tries <= 50 Then
                    TextSquares(NewIndex).Text = LastNumber.ToString
                    CurrentBox = NewIndex
                    LastNumber += 1
                Else
                    Exit For
                End If
            Next
            Me.Text = "Test, made it to " & (LastNumber - 1).ToString
            If LastNumber >= 81 Then MessageBox.Show("Success") ' What ? It actually worked ?
        End Sub
    End Class
    

    Typical Result: Note how it gets to 41 and now has nowhere to go.

    Friday, December 14, 2018 1:00 AM

All replies

  • Could you be a lot more clear about the rules please. 

    edit: I found the rules online.


    "Those who use Application.DoEvents() have no idea what it does and those who know what it does never use it."

    - from former MSDN User JohnWein

    SerialPort Info

    Multics - An OS ahead of its time.


    • Edited by dbasnett Friday, December 14, 2018 2:58 PM
    Friday, December 14, 2018 2:40 PM
  • Thanks!!!!  Something to mess with my mind ;)  So I took your code and massaged it.  Created a couple of classes and have it to the point that all that is needed is a solution.  The code for that has a start.

    the classes

    <Flags> Public Enum direction
        none = 0
        n = 1 << 0
        e = 1 << 1
        s = 1 << 2
        w = 1 << 3
        all = n Or e Or s Or w
    End Enum
    
    Public Class NumBrix
        Private Shared PRNG As New Random
        Private H As Integer
        Private W As Integer
        Private Grid As New List(Of List(Of GridBox)) 'y = row, x= col
        Public nums As List(Of Integer)
    
        Public Sub New(Optional Height As Integer = 9,
                       Optional Width As Integer = 9)
    
            Me.H = Height
            Me.W = Width
    
            Dim ct As Integer = 0
            For y As Integer = 0 To Me.H - 1
                Grid.Add(New List(Of GridBox))
                For x As Integer = 0 To Me.W - 1
                    Dim gb As New GridBox
                    With gb.TxtB
                        '.Text = (ct + 1).ToString
                        .Tag = ct + 1
                        .Width = 60
                        .Height = 50
                        .Left = 40 + (61 * (x Mod Me.W))
                        .Top = 60 + (47 * y) '10 for test, 22 norm
                    End With
                    gb.MyLoc = New Point(x, y)
    
                    gb.DirCan = direction.all 'which direction can we go from this box
                    If x = 0 Then gb.DirCan = gb.DirCan Xor direction.w
                    If x = Me.W - 1 Then gb.DirCan = gb.DirCan Xor direction.e
                    If y = 0 Then gb.DirCan = gb.DirCan Xor direction.n
                    If y = Me.H - 1 Then gb.DirCan = gb.DirCan Xor direction.s
    
                    Grid(y).Add(gb)
                    ct += 1
                Next
            Next
        End Sub
    
        Public Sub NewGame()
            For Each gb As GridBox In Me.AllBoxes
                gb.IsUsed = False
                gb.TxtB.Text = ""
            Next
            Me.nums = Enumerable.Range(1, Me.H * Me.W).ToList 'list of numbers
            Dim sb As GridBox = Me.RandGridBox
            Me.FillBoxes(sb)
        End Sub
    
    #Region "Code needed in here"
    
        Private Sub FillBoxes(gb As GridBox)
            gb.TxtB.Text = nums(0).ToString
            gb.IsUsed = True
            nums.RemoveAt(0)
            If nums.Count > 0 Then
                Dim nb As List(Of GridBox) = Me.Neighbors(gb)
                If nb.Count > 0 Then
                    Dim agb As GridBox = nb(PRNG.Next(nb.Count))
                    Me.FillBoxes(agb)
                End If
            End If
        End Sub
    
    #End Region
    
        Public Function Neighbors(gb As GridBox, Optional OnlyNotUsed As Boolean = True) As List(Of GridBox)
            Dim pts As New List(Of Point)
            pts.Add(gb.NorthN)
            pts.Add(gb.EastN)
            pts.Add(gb.SouthN)
            pts.Add(gb.WestN)
    
            Dim rv As New List(Of GridBox)
            For Each pt As Point In pts
                If pt.X = -1 Then Continue For 'filter
                Dim agb As GridBox = Me.Grid(pt.Y).Item(pt.X)
                If OnlyNotUsed AndAlso Not agb.IsUsed Then
                    rv.Add(agb)
                ElseIf OnlyNotUsed Then
    
                Else
                    rv.Add(agb)
                End If
            Next
            Return rv
        End Function
    
        Public Function AllBoxes() As List(Of GridBox)
    
            Return (From gbl In Me.Grid
                    Let gbi = gbl.ToList
                    From gb In gbi Select gb).ToList
    
        End Function
    
        Public Function RandLoc() As Point
            Dim y As Integer = PRNG.Next(Me.H)
            Dim x As Integer = PRNG.Next(Me.W)
            Return New Point(x, y)
        End Function
    
        Public Function RandGridBox() As GridBox
            Dim y As Integer = PRNG.Next(Me.H)
            Dim x As Integer = PRNG.Next(Me.W)
            Return Me.Grid(y).Item(x)
        End Function
    End Class
    
    Public Class GridBox
        Public MyLoc As Point
        Public DirCan As direction = direction.none
        Public TxtB As TextBox
        Public IsUsed As Boolean = False
        Public Sub New()
            Me.TxtB = New TextBox
            With Me.TxtB
                .Text = ""
                .BorderStyle = BorderStyle.FixedSingle
                .Multiline = True
                .TextAlign = HorizontalAlignment.Center
                .[ReadOnly] = True
                .ForeColor = Color.Black
                .BackColor = Color.White
                .ShortcutsEnabled = False
                .Font = New Font("Consolas", 18, FontStyle.Bold)
            End With
        End Sub
    
        Public Function NorthN() As Point
            If (Me.DirCan And direction.n) = direction.n Then
                Return New Point(Me.MyLoc.X, Me.MyLoc.Y - 1)
            Else
                Return New Point(-1, -1)
            End If
        End Function
    
        Public Function EastN() As Point
            If (Me.DirCan And direction.e) = direction.e Then
                Return New Point(Me.MyLoc.X + 1, Me.MyLoc.Y)
            Else
                Return New Point(-1, -1)
            End If
        End Function
    
        Public Function SouthN() As Point
            If (Me.DirCan And direction.s) = direction.s Then
                Return New Point(Me.MyLoc.X, Me.MyLoc.Y + 1)
            Else
                Return New Point(-1, -1)
            End If
        End Function
    
        Public Function WestN() As Point
            If (Me.DirCan And direction.w) = direction.w Then
                Return New Point(Me.MyLoc.X - 1, Me.MyLoc.Y)
            Else
                Return New Point(-1, -1)
            End If
        End Function
    End Class
    

    Test code

    Public Class Form1
    
        Private MyNumBrix As New NumBrix
    
        Private Sub btnCR_Click(sender As Object, e As EventArgs) Handles btnCR.Click
            MyNumBrix.NewGame()
            For Each gb As GridBox In MyNumBrix.AllBoxes
                'gb.TxtB.Text = gb.MyLoc.X.ToString & " " & gb.MyLoc.Y.ToString
            Next
            Me.TextBox1.Text = MyNumBrix.nums(0).ToString
        End Sub
    
        Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
            For Each gb As GridBox In MyNumBrix.AllBoxes
                Me.Controls.Add(gb.TxtB)
            Next
        End Sub
    End Class
    


    "Those who use Application.DoEvents() have no idea what it does and those who know what it does never use it."

    - from former MSDN User JohnWein

    SerialPort Info

    Multics - An OS ahead of its time.

    Friday, December 14, 2018 9:40 PM
  • Very nice - I'm pretty sure that you know what I'm hoping to get is not so much "where can the next number go" but "where should the next number go" - not an easy thing to implement.

     

    Sunday, December 16, 2018 5:07 AM