022
11.09.2010, 17:24 Uhr
labman
|
Hello Manfred-BW , I know this is an old subject, but i just thought of a linear solution:
this solves a general dreiertable in an general matrix.
the approach is to hash the dreiertable then just linear scan for pattern.
fun problem !
HTH labman
' matrix problem, different approach, by lb / labman
' not optimized for clarity
' written in gfabasic32, see http://sites.google.com/site/gfabasic322/
Global dreiermaks = 8 'highest number in dreiertable
Local mx = 20 'matrix width
Local my = 20 'matrix height
Local matrixmaks = 15 'highest number in matrix ( must be bigger than mx!)
matrixmaks = Max(mx, matrixmaks)
Global Dim entry(dreiermaks ^ 3) As Boolean 'this holds all used kombinations of the dreiertable
Global Dim matr(mx, my)
Randomize 100
dreier(dreiermaks)
matrixgen(mx, my, matrixmaks) ' width, height to pattern search
Print "# of matches:"; findpattern(mx, my)
Proc dreier(dmaks)
Local a, b, c, slotindex
For a = 1 To dmaks
For b = a + 1 To dmaks
For c = b + 1 To dmaks
Print a; b; c
slotindex = a * dreiermaks * dreiermaks + b * dreiermaks + c
entry(slotindex) = True
Next c
Next b
Next a
Proc matrixgen(mx, my, mmaks)
Dim picktable(mmaks)
Local x, y, mark, num
For y = 1 To my
' produce some uniqe numbers for each row
' mark mx * tableentries by random
mark = 1
Repeat
num = Random(mmaks) + 1
If picktable(num) = 0
picktable(num) = 1
Inc mark
EndIf
Until mark > mx
Debug mark
' fill matrix row with sorted numbers
x = 0
For mark = 1 To mmaks
If picktable(mark)
Inc x
matr(x, y) = mark
Print AT(10 + x * 3, y); mark
EndIf
Next mark
Debug x;
ArrayFill picktable(), 0
Next y
EndProc
Function findpattern(mx, my)
Local x, y, key, found
For y = 1 To my
For x = 1 To mx - 4
If matr(x, y) < dreiermaks And matr(x + 1, y) < dreiermaks And matr(x + 2, y) < dreiermaks
key = matr(x, y) * 36 + matr(x + 1, y) * 6 + matr(x + 2, y)
If entry(key)
Inc found
EndIf
EndIf
Next x
Next y
Return found
EndFunc  |
