My First InForm Program - Trackword

[bplus]

Here is a much more interesting screen full. 9 letter words that have 200 or more words snaked around the 3x3 grid.

   

Now I am wondering how many are anagrams of each other.

[bplus]

I was surprised, not many of the Trackword 200+ were anagrams of each other:

Code: QB64: [Select]

1. _TITLE "Trackword 200 Anagram Analysis"
2. CONST ww = 800
3. CONST wh = 600
4.  
5. SCREEN _NEWIMAGE(ww, wh, 32)
6. _SCREENMOVE (1280 - ww) / 2 + 30, (760 - wh) / 2
7.  
8. 'PRINT AnagramTF%("artss", "stars")      'yeah!
9. DIM w$(70), a$(70)
10. wTop = 0
11. OPEN "Trackword 200.txt" FOR INPUT AS #1
12. WHILE NOT EOF(1)
13.     wTop = wTop + 1
14.     INPUT #1, w$(wTop)
15. WEND
16. CLOSE #1
17. FOR i = 1 TO wTop
18.     IF w$(i) <> "" THEN
19.         ai = ai + 1
20.         a$(ai) = w$(i)
21.         FOR j = i + 1 TO wTop
22.             IF w$(j) <> "" THEN
23.                 IF AnagramTF(w$(i), w$(j)) THEN
24.                     a$(ai) = a$(ai) + " " + w$(j) 'move to i word group
25.                     w$(j) = "" ' this word is used
26.                 END IF
27.             END IF
28.         NEXT
29.     END IF
30. NEXT
31. 'show results
32. FOR i = 1 TO ai
33.     IF i > 33 THEN
34.         l = i - 33: m = 40
35.     ELSE
36.         l = i: m = 1
37.     END IF
38.     LOCATE l, m: PRINT i; " "; a$(i)
39. NEXT
40.  
41. FUNCTION AnagramTF% (w1$, w2$)
42.     'this only works for words 9 repeated letters or less
43.     IF LEN(w1$) <> LEN(w2$) THEN EXIT FUNCTION 'false
44.     'still here
45.     aw1$ = STRING$(26, "0")
46.     aw2$ = aw1$
47.     FOR i = 1 TO LEN(w1$)
48.         c$ = UCASE$(MID$(w1$, i, 1))
49.         ac = ASC(c$) - 64
50.         vc = VAL(MID$(aw1$, ac, 1))
51.         MID$(aw1$, ac, 1) = LTRIM$(STR$(vc + 1))
52.         c$ = UCASE$(MID$(w2$, i, 1))
53.         ac = ASC(c$) - 64
54.         vc = VAL(MID$(aw2$, ac, 1))
55.         MID$(aw2$, ac, 1) = LTRIM$(STR$(vc + 1))
56.     NEXT
57.     IF aw1$ = aw2$ THEN AnagramTF% = -1
58. END FUNCTION
59.  

EDIT: fix with Ltrim$ the str$ of values

Dang! missing last word.
EDIT 2: fixed

[Qwerkey]

bplus, you certainly seem to have found much interest in this little problem.  Thanks for your stimulating inputs.

Richard

[Qwerkey]

Another interesting thing to investigate is whether an arrangement of letters gives more than one nine-letter solution.

If you use the following grid, you gey both CARTHORSE and ORCHESTRA (well-known anagrams of each other):
CAR
RHT
OSE

I think that I remmber Clive Doig (he who invented Trackword) setting a puzzle where there were three nine-letter anagrams.  Can there be more than one such solution?  I don't suppose that there can be more than three?

Richard

[Qwerkey]

bplus, the following arrangements (and others) all give the same results:

CAR   OSE   CRO   ETR
RHT   RHT    AHS   SHA
OSE   CAR   RTE   ORC

Working out symmetry considerations is beyond me.  Can we reduce HalfABC further by symmetry considerations?  Can we reduce search time even more?

Richard

[bplus]

Hi Richard,

With the 3x3 grid, there were 3 types of square, the corner, the side, and the middle. The middle was unique but the corner and side had 3 equivalent rotations that likely could be "translated" number for number for the snake patterns and in same manner for the letter patterns. The snakes could be worked out with results from one corner, side and middle but snakes are one time shot. Doing the same with letter patterns would likely take longer to calculate and translate than just translating a snake pattern to a letter pattern, So is it worth it to reduce snake patterns but require and do the same amount of translations?

The reverse trick was quite clever, easiest to understand and use.

Have you any thought about 4x4 grids? Probably learn even fancier words. :D   If one bothers to check them out eg, wadsetter :)  Which reminds me, do I have an actual dictionary with word AND definition? Such would be a natural addition if you'd like to try Menus with InForm. Heck, it might even be educational, learn while playing... :)

PS a message box would be handy for a quick definition.

[Qwerkey]

Good heavens, bplus!  I am startled to find that our little topic here has made it into the Top Ten posts by replies.  We have only 21 more suggestions each and then we get to No. 1!

Richard

[bplus]

Oh rats!

You have me looking for, and then at, forum stats. Interesting...

Well as Fellippe has mentioned numbers don't exactly mean quality but as I said, quantity is one quality of many...

How does Odin have so many posts? I looked at a quality Odin's posts, only 2 pages not exactly 500+ ???

Append: OK so it doesn't look like a blatant inflation of replies, something more on topic and that I am curious about.

What do you all think of adding an additional capability to define words? To me, it is a most logical, practical, educational and maybe even fun extension of this application of InForm.

[FellippeHeitor]

Odin wanted to show from the start that post racing would be frowned upon

[bplus]

Odin wanted to show from the start that post racing would be frowned upon

[Qwerkey]

User Manual replaced in first section (updated with finished program instructions).  Previous version plus temporary updated version here downloaded 125/39 times (this reply modified 16/02/2019).

[codeguy]

one more attack that may speed up your progress is to generate permutations of your letters in alphabetic order and then do a modified merge search. Since the permutations are in the same lexicographical order as Steve's word list, there is no need to do binary search with a sorted array. Here is the code for generating permutations in ascending order.

Code: [Select]

WIDTH 80, 43
DIM parray(0 TO 8) AS LONG
FOR i = 0 TO UBOUND(parray)
    parray(i) = i
NEXT
PRINT
PRINT
PRINT "permutations"
Permute parray(), 0, UBOUND(parray), np
DO
    x$ = INKEY$
LOOP UNTIL x$ > ""
SYSTEM

SUB DisplayResults (PArray() AS LONG, start, finish, np AS DOUBLE)
DIM i AS LONG
PRINT USING "#,###,###,###,###"; np;
FOR i = LBOUND(parray) TO UBOUND(parray)
    PRINT PArray(i);
NEXT
PRINT
END SUB

SUB Rotate (parray() AS LONG, Start AS LONG, finish AS LONG)
DIM ts AS LONG
ts = parray(Start)
FOR i = Start TO finish - 1
    SWAP parray(i), parray(i + 1)
NEXT
parray(finish) = ts
END SUB

SUB Permute (parray() AS LONG, start AS LONG, finish AS LONG, np AS DOUBLE)
np = np + 1
DisplayResults parray(), LBOUND(parray), UBOUND(parray), np
IF start < finish THEN
    DIM i AS LONG
    DIM j AS LONG
    FOR i = finish - 1 TO start STEP -1
        FOR j = i + 1 TO finish
            SWAP parray(i), parray(j)
            Permute parray(), i + 1, finish, np
        NEXT
        Rotate parray(), i, finish
    NEXT
END IF
END SUB


Code: QB64: [Select]

1. '* essentially finds the intersection of 2 arrays
2. '* both arrays must be sorted exactly the same order.
3. SUB ModifiedMergeSearch (StevesWordList$(), MyWordList$())
4. a& = 0
5. b& = 0
6. DO
7.     IF a& > UBOUND(StevesWordList$) THEN
8.         EXIT DO
9.     ELSE
10.         IF b& > UBOUND(MyWordList$) THEN
11.             EXIT DO
12.         ELSE
13.             IF StevesWordList$(a&) > MyWordList$(b&) THEN
14.                 b& = b& + 1
15.             ELSEIF StevesWordList$(a&) < MyWordList$(b&) THEN
16.                 a& = a& + 1
17.             ELSE
18.                 '* it's a word in both lists
19.                 '* advance both pointers
20.                 a& = a& + 1
21.                 b& = b& + 1
22.             END IF
23.         END IF
24.     END IF
25. LOOP
26. EXIT SUB
27.  

[Qwerkey]

Hmm.  Thanks codeguy.  I'm knee-deep in another program at the moment, but then I'll try to give this some consideration.

Richard