+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: program to draw a grid of grids and out put all unique 3X3 patterns (/showthread.php?tid=3957)
RE: program to draw a grid of grids and out put all unique 3X3 patterns - bplus - 09-23-2025
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 FunctionI 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 SubSo 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.
RE: program to draw a grid of grids and out put all unique 3X3 patterns - bplus - 09-24-2025
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 FunctionSample testing a Glyph and its rotations, showing matches in j numbers.
Sample of the Results$() Report:
RE: program to draw a grid of grids and out put all unique 3X3 patterns - Pete - 09-24-2025
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
RE: program to draw a grid of grids and out put all unique 3X3 patterns - bplus - 09-24-2025
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!
RE: program to draw a grid of grids and out put all unique 3X3 patterns - SMcNeill - 09-24-2025
(09-24-2025, 06:21 PM)bplus Wrote: 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!
RE: program to draw a grid of grids and out put all unique 3X3 patterns - PhilOfPerth - 09-25-2025
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.