program to draw a grid of grids and out put all unique 3X3 patterns

[bplus]

I GOT IT, a working IsGlyph%(index512) Function AND it confirms my manual count made in reply #17 above. Namely 379 Proper Glyphs can be found in ALL the different fills of a TTT board or 3x3 cell space.

Here is the IsGlyph%(Index512) Function:

Code: (Select All)

Function IsGlyph% (Index512 As Integer)
    Dim As Integer x, y, index, CCount, nc, nc1, a(4, 4)
    ' load a array with 1 if cell is there leave 0 if not
    For y = 0 To 2
        For x = 0 To 2
            index = y * 3 + x
            If (Index512 And (2 ^ index)) Then a(x + 1, y + 1) = 1: CCount = CCount + 1
        Next
    Next
    If CCount <= 1 Then Exit Function ' not a Glyph more than one cell needed for Glyph
    If CCount > 1 And a(2, 2) = 1 Then IsGlyph% = -1: Exit Function ' center cell means Glyph automatically

    ' ok now for cells in a() do a neighbor count like in Conway Game of Life, loading nc()
    For y = 1 To 3
        For x = 1 To 3
            If a(x, y) Then ' count neighbors  by summing 8 cells around (x, y)
                nc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
                If nc = 0 Then Exit Function ' isolated cell = NOT A Glyph!
                If nc = 1 Then
                    nc1 = nc1 + 1
                    If nc1 > 2 Then Exit Function ' too many dead ends, not a glyph
                End If
            End If
        Next
    Next
    'still here?
    IsGlyph% = -1 ' It passed all my tests !
End Function

I used it to make sure it was a Glyph in the GlyphDraw Sub and I counted all Glyphs drawn for the Shared ProperGlyphCount:

Code: (Select All)

_Title "3x3 TTT Cell fills IsGlyph Function" ' bplus 2025-09-23
'from
'_title "512 Variations Of TTT Board Fill" 'bplus 2025-09-22

Const PIXEL_SIZE = 7
Const GLYPH_SIZE = 3 * PIXEL_SIZE
Const CELL_SIZE = GLYPH_SIZE + 15
Const GRID_WIDTH = 32
Const GRID_HEIGHT = 16
Const SCREEN_WIDTH = GRID_WIDTH * CELL_SIZE + 15
Const SCREEN_HEIGHT = GRID_HEIGHT * CELL_SIZE + 15

Dim Shared ProperGlyphCount
Dim glyphs(511) As Integer

Screen _NewImage(SCREEN_WIDTH, SCREEN_HEIGHT, 32)
_ScreenMove 60, 60

' Fill background with blue
Line (0, 0)-(SCREEN_WIDTH - 1, SCREEN_HEIGHT - 1), _RGB32(32, 32, 196), BF

' Generate 260 random glyphs (0 to 511)
Randomize Timer
For i = 0 To 511
    glyphs(i) = i
Next

' Draw each glyph at its OGN location
For ogn% = 0 To 511
    GlyphDraw glyphs(ogn%), ogn%
Next

' Overlay grid lines
DrawGridOverlay

'_PrintString (5, SCREEN_HEIGHT - 20), "Press any key to exit..."
'Do: Loop Until InKey$ <> ""
_MessageBox "Proper Glyphs that can be made from 512 different TTT board fills", " is" + Str$(ProperGlyphCount)
System

Sub GlyphDraw (shape%, ogn%)
    If IsGlyph%(ogn%) = 0 Then Exit Sub Else ProperGlyphCount = ProperGlyphCount + 1
    Dim row%, col%, index%, x%, y%
    Dim baseX%, baseY%
    baseX% = (ogn% Mod GRID_WIDTH) * CELL_SIZE
    baseY% = (ogn% \ GRID_WIDTH) * CELL_SIZE

    For row% = 0 To 2
        For col% = 0 To 2
            index% = row% * 3 + col%
            x% = baseX% + col% * PIXEL_SIZE + 15
            y% = baseY% + row% * PIXEL_SIZE + 15
            If (shape% And (2 ^ index%)) Then
                Line (x%, y%)-(x% + PIXEL_SIZE - 1, y% + PIXEL_SIZE - 1), _RGB32(76, 255, 0), BF
            Else
                Line (x%, y%)-(x% + PIXEL_SIZE - 1, y% + PIXEL_SIZE - 1), _RGB32(0, 96, 0), BF
            End If
        Next
    Next
End Sub

Function IsGlyph% (Index512 As Integer)
    Dim As Integer x, y, index, CCount, nc, nc1, a(4, 4)
    ' load a array with 1 if cell is there leave 0 if not
    For y = 0 To 2
        For x = 0 To 2
            index = y * 3 + x
            If (Index512 And (2 ^ index)) Then a(x + 1, y + 1) = 1: CCount = CCount + 1
        Next
    Next
    If CCount <= 1 Then Exit Function ' not a Glyph more than one cell needed for Glyph
    If CCount > 1 And a(2, 2) = 1 Then IsGlyph% = -1: Exit Function ' center cell means Glyph automatically

    ' ok now for cells in a() do a neighbor count like in Conway Game of Life, loading nc()
    For y = 1 To 3
        For x = 1 To 3
            If a(x, y) Then ' count neighbors  by summing 8 cells around (x, y)
                nc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
                If nc = 0 Then Exit Function ' isolated cell = NOT A Glyph!
                If nc = 1 Then
                    nc1 = nc1 + 1
                    If nc1 > 2 Then Exit Function ' too many dead ends, not a glyph
                End If
            End If
        Next
    Next
    'still here?
    IsGlyph% = -1 ' It passed all my tests !
End Function

Sub DrawGridOverlay
    Dim gx%, gy%, x%, y%
    For gx% = 0 To GRID_WIDTH - 1
        For gy% = 0 To GRID_HEIGHT - 1
            x% = gx% * CELL_SIZE + 15
            y% = gy% * CELL_SIZE + 15
            For i = 1 To 2
                Line (x% + i * PIXEL_SIZE, y%)-(x% + i * PIXEL_SIZE, y% + GLYPH_SIZE - 1), _RGB32(0) ', 128, 128), BF
                Line (x%, y% + i * PIXEL_SIZE)-(x% + GLYPH_SIZE - 1, y% + i * PIXEL_SIZE), _RGB32(0) ', 128, 128), BF
            Next
        Next
    Next
End Sub

So we get the same graphic I showed you last night in reply #17 only done by Computer coding rather than on sight elimination of Improper Glyphs.

   

I am going to stick a feather in my hat before I move onto uniqueness of Glyphs. BTW I used simple variable nc in place of an nc() array and forgot to change a comment.

[bplus]

OK and now I am checking rotations of each glyph. If a glyph matches a rotation of an earlier glyph then it is Not counted as Unique I go through all the patterns, if the pattern is a Glyph then I check if it matched a rotation of an earlier Glyph, if not it is Unique and that count is incremented other wise it is recorded in the Result$() as an earlier rotation.

I get 102 Unique Glyphs when we don't count rotations.

Code: (Select All)

_Title "Glyph Rotations a first step for uniqueness testing" 'bplus 2025-09-23
Screen _NewImage(800, 600, 32)
_ScreenMove 200, 60

' test index 11 3 blocks at upper left corner
Dim Result$(511)
Dim As Integer i, j, row, col, gly(2, 2), glyR1(2, 2), glyR2(2, 2), glyR3(2, 2), gly2(2, 2)
For i = 0 To 511
    If IsGlyph%(i) Then
        If Result$(i) = "" Then
            Unique = Unique + 1
            Result$(i) = "Unigue Glyph" + Str$(Unique)
            Cls: Print "Testing glyph "; i
            Glyph i, gly()
            'For row = 0 To 2
            '    For col = 0 To 2
            '        Print gly(col, row);
            '    Next
            '    Print
            'Next      'good!
            drawGlyph 100, 100, gly(), 10 ' OK

            A3x3Rot90CW gly(), glyR1()
            drawGlyph 200, 100, glyR1(), 10

            A3x3Rot90CW glyR1(), glyR2()
            drawGlyph 300, 100, glyR2(), 10

            A3x3Rot90CW glyR2(), glyR3()
            drawGlyph 400, 100, glyR3(), 10
            If i < 511 Then
                For j = i + 1 To 511
                    Glyph j, gly2() ' test this to rotations
                    If arrEq(gly2(), glyR1()) Then
                        drawGlyph 200, 200, gly2(), 10
                        _PrintString (200, 250), "j =" + Str$(j)
                        Result$(j) = Str$(j) + " is " + Str$(i) + " Rot90CW once."
                    ElseIf arrEq(gly2(), glyR2()) Then
                        drawGlyph 300, 200, gly2(), 10
                        _PrintString (300, 250), "j =" + Str$(j)
                        Result$(j) = Str$(j) + " is " + Str$(i) + " Rot90CW twice."
                    ElseIf arrEq(gly2(), glyR3()) Then
                        drawGlyph 400, 200, gly2(), 10
                        _PrintString (400, 250), "j =" + Str$(j)
                        Result$(j) = Str$(j) + " is " + Str$(i) + " Rot90CW thrice."
                    End If

                Next
            End If
            'Else this glyph has matched a rotation already so not unique

        End If

    Else
        Result$(i) = "Not a Glyph"
    End If
    _Delay .2
Next
Cls
Print "The number of unique glyphs is"; Unique: Print
For i = 0 To 511
    Print i, Result$(i)
    If i Mod 25 = 24 Then
        Print "Press any... ": Sleep: Cls: Print "The number of unique glyphs is"; Unique: Print
    End If
Next


Function arrEq (a1() As Integer, a2() As Integer)
    For y = 0 To 2
        For x = 0 To 2
            If a1(x, y) <> a2(x, y) Then Exit Function
        Next
    Next
    'still here?
    arrEq = -1
End Function

Sub drawGlyph (x As Integer, y As Integer, glyArr() As Integer, side As Integer)
    Dim As Integer row, col, index

    For row = 0 To 2
        For col = 0 To 2
            If glyArr(col, row) = 1 Then
                Line (x + col * side, y + row * side)-Step(side - 2, side - 2), _RGB32(76, 255, 0), BF
            Else
                Line (x + col * side, y + row * side)-Step(side - 2, side - 2), _RGB32(255, 76, 0), BF
            End If
        Next
    Next

End Sub

Sub A3x3Rot90CW (aIn() As Integer, aOut() As Integer)
    aOut(2, 0) = aIn(0, 0)
    aOut(2, 1) = aIn(1, 0)
    aOut(2, 2) = aIn(2, 0)
    aOut(1, 0) = aIn(0, 1)
    aOut(1, 1) = aIn(1, 1)
    aOut(1, 2) = aIn(2, 1)
    aOut(0, 0) = aIn(0, 2)
    aOut(0, 1) = aIn(1, 2)
    aOut(0, 2) = aIn(2, 2)
End Sub

Sub Glyph (Index512Input As Integer, ArrOut() As Integer)
    Dim As Integer x, y, index
    ' load ArrOut() array with 1 if cell is there leave 0 if not
    For y = 0 To 2
        For x = 0 To 2
            index = y * 3 + x
            If (Index512Input And (2 ^ index)) Then ArrOut(x, y) = 1 Else ArrOut(x, y) = 0
        Next
    Next
End Sub

Function IsGlyph% (Index512 As Integer)
    Dim As Integer x, y, index, CCount, nc, nc1, a(4, 4)
    ' load a array with 1 if cell is there leave 0 if not
    For y = 0 To 2
        For x = 0 To 2
            index = y * 3 + x
            If (Index512 And (2 ^ index)) Then a(x + 1, y + 1) = 1: CCount = CCount + 1
        Next
    Next
    If CCount <= 1 Then Exit Function ' not a Glyph more than one cell needed for Glyph
    If CCount > 1 And a(2, 2) = 1 Then IsGlyph% = -1: Exit Function ' center cell means Glyph automatically

    ' ok now for cells in a() do a neighbor count like in Conway Game of Life, loading nc()
    For y = 1 To 3
        For x = 1 To 3
            If a(x, y) Then ' count neighbors  by summing 8 cells around (x, y)
                nc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
                If nc = 0 Then Exit Function ' isolated cell = NOT A Glyph!
                If nc = 1 Then
                    nc1 = nc1 + 1
                    If nc1 > 2 Then Exit Function ' too many dead ends, not a glyph
                End If
            End If
        Next
    Next
    'still here?
    IsGlyph% = -1 ' It passed all my tests !
End Function

Sample testing a Glyph and its rotations, showing matches in j numbers.
   

Sample of the Results$() Report:
   

[Pete]

Now try using GLUT and solve for Rubik's Cube.

I miss the days I could wrap my head around this kind of stuff and hammer things out. Nowadays I read stuff like this and wrap my head with a hammer until I pass out.

+2

Pete

[bplus]

Thank you @Pete

I have days like those now too. This thread I am pretty proud of the IsGlyph% Function PLUS always cool to help someone with their code. 

The most recent post about rotations was pretty hastely put together and I am kicking myself for not checking that the rotations of a Glyph are unique. eg a picture frame glyph with only the center missing is going to be the same thing on each rotation of 90 degrees, and a glyph with a line through center like TTT through center will only have 2 unique forms not 4 because of symmetry. BUT the If Then ElseIf... ElseIf... End If gauntlet should prevent redundant glyph checking.

379 possible Glyphs from filling TTT board divided by 1 to 4 rotations per unique Glyph does come out to around 100.

So I'd sure like to see where @Dragoncat got the idea and number for 260.

PS oh by the way, on You Tube I learned that you could solve a Rubics Cube by repeating over and over a pattern of 3 moves. You only have to pay attention to having all the sides match so you know you are done!

[SMcNeill]

So I'd sure like to see where @Dragoncat got the idea and number for 260.

That's my concern.  That (and lack of time) has been why I haven't sat and wrote any actual code towards the issue yet.  Dragoncat's post made it sound like the solution was absolute -- like one a teacher might assign to a class to prove -- and rather detailed in its breakdown and figures.  Yet it doesn't match what either of us has predicted so far.  That makes it seem like there was some rule left out (has to be 3 tiles in size or some such) that we're missing out on.

Until Dragoncat comes back to the forums in another six months and posts again, I don't think anyone could ever definitely say, "Hey!  I got it!"  I don't even know if we're playing the game by the same rules.  We might be playing tic-tac-toe while this is more miniature chinese checkers! 

[PhilOfPerth]

My calculations may be wrong (they often are lately), but as I see it, if the grid is like this:
1 2 3
4 5 6
7 8 9
I believe there are 272 unique situations where two or more tiles are in line, with no rotations.
These are for corners: 12  14  15  123 and 159, with 2^4 variants for the remaining tiles, so 80
and for edges: 24  25  and 258, with 2^ 6 variants for the remaining tiles, so 192.
Just my two-bits worth.