Word search: Difference between revisions
Content added Content deleted
SqrtNegInf (talk | contribs) m (→{{header|Perl}}: future-proof for 5.36, use new bitwise string operators) |
(Dialects of BASIC moved to the BASIC section.) |
||
Line 226: | Line 226: | ||
ala (5,2)(3,0) wok (8,0)(8,2) |
ala (5,2)(3,0) wok (8,0)(8,2) |
||
</pre> |
</pre> |
||
=={{header|BASIC}}== |
|||
==={{header|FreeBASIC}}=== |
|||
{{trans|QB64}} |
|||
Changes: |
|||
ShowPuzzle gets call only after a word is inserted in the grid. |
|||
Added a check if unixdict.txt was found. |
|||
Made FilePuzzle print to the file. |
|||
If enough words are found but there where still spaces, fill them with random letters. |
|||
FILLED was not set to FALSE every time Initialize was called. |
|||
Set all integer to (U)long. |
|||
<syntaxhighlight lang="freebasic">Randomize Timer ' OK getting a good puzzle every time |
|||
#Macro TrmSS (n) |
|||
LTrim(Str(n)) |
|||
#EndMacro |
|||
'overhauled |
|||
Dim Shared As ULong LengthLimit(3 To 10) 'reset in Initialize, track and limit longer words |
|||
'LoadWords opens file of words and sets |
|||
Dim Shared As ULong NWORDS 'set in LoadWords, number of words with length: > 2 and < 11 and just letters |
|||
' word file words (shuffled) to be fit into puzzle and index position |
|||
Dim Shared As String WORDSSS(1 To 24945), CWORDSSS(1 To 24945) |
|||
Dim Shared As ULong WORDSINDEX 'the file has 24945 words but many are unsuitable |
|||
'words placed in Letters grid, word itself (WSS) x, y head (WX, WY) and direction (WD), WI is the index to all these |
|||
Dim Shared As String WSS(1 To 100) |
|||
Dim Shared As ULong WX(1 To 100), WY(1 To 100), WD(1 To 100), WI |
|||
' letters grid and direction arrays |
|||
Dim Shared As String LSS(0 To 9, 0 To 9) |
|||
Dim Shared As Long DX(0 To 7), DY(0 To 7) |
|||
DX(0) = 1: DY(0) = 0 |
|||
DX(1) = 1: DY(1) = 1 |
|||
DX(2) = 0: DY(2) = 1 |
|||
DX(3) = -1: DY(3) = 1 |
|||
DX(4) = -1: DY(4) = 0 |
|||
DX(5) = -1: DY(5) = -1 |
|||
DX(6) = 0: DY(6) = -1 |
|||
DX(7) = 1: DY(7) = -1 |
|||
'to store all the words found embedded in the grid LSS() |
|||
Dim Shared As String ALLSS(1 To 200) |
|||
Dim Shared As ULong AllX(1 To 200), AllY(1 To 200), AllD(1 To 200) 'to store all the words found embedded in the grid LSS() |
|||
Dim Shared As ULong ALLindex |
|||
' signal successful fill of puzzle |
|||
Dim Shared FILLED As Boolean |
|||
Dim Shared As ULong try = 1 |
|||
Sub LoadWords |
|||
Dim As String wdSS |
|||
Dim As ULong i, m, ff = FreeFile |
|||
Dim ok As Boolean |
|||
Open "unixdict.txt" For Input As #ff |
|||
If Err > 0 Then |
|||
Print !"\n unixdict.txt not found, program will end" |
|||
Sleep 5000 |
|||
End |
|||
End If |
|||
While Eof(1) = 0 |
|||
Input #ff, wdSS |
|||
If Len(wdSS) > 2 And Len(wdSS) < 11 Then |
|||
ok = TRUE |
|||
For m = 1 To Len(wdSS) |
|||
If Asc(wdSS, m) < 97 Or Asc(wdSS, m) > 122 Then ok = FALSE: Exit For |
|||
Next |
|||
If ok Then i += 1: WORDSSS(i) = wdSS: CWORDSSS(i) = wdSS |
|||
End If |
|||
Wend |
|||
Close #ff |
|||
NWORDS = i |
|||
End Sub |
|||
Sub Shuffle |
|||
Dim As ULong i, r |
|||
For i = NWORDS To 2 Step -1 |
|||
r = Int(Rnd * i) + 1 |
|||
Swap WORDSSS(i), WORDSSS(r) |
|||
Next |
|||
End Sub |
|||
Sub Initialize |
|||
Dim As ULong r, c'', x, y, d |
|||
Dim As String wdSS |
|||
FILLED = FALSE |
|||
For r = 0 To 9 |
|||
For c = 0 To 9 |
|||
LSS(c, r) = " " |
|||
Next |
|||
Next |
|||
'reset word arrays by resetting the word index back to zero |
|||
WI = 0 |
|||
'fun stuff for me but doubt others would like that much fun! |
|||
'pluggin "basic", 0, 0, 2 |
|||
'pluggin "plus", 1, 0, 0 |
|||
'to assure the spreading of ROSETTA CODE |
|||
LSS(Int(Rnd * 5) + 5, 0) = "R": LSS(Int(Rnd * 9) + 1, 1) = "O" |
|||
LSS(Int(Rnd * 9) + 1, 2) = "S": LSS(Int(Rnd * 9) + 1, 3) = "E" |
|||
LSS(1, 4) = "T": LSS(9, 4) = "T": LSS(Int(10 * Rnd), 5) = "A" |
|||
LSS(Int(10 * Rnd), 6) = "C": LSS(Int(10 * Rnd), 7) = "O" |
|||
LSS(Int(10 * Rnd), 8) = "D": LSS(Int(10 * Rnd), 9) = "E" |
|||
'reset limits |
|||
LengthLimit(3) = 200 |
|||
LengthLimit(4) = 6 |
|||
LengthLimit(5) = 3 |
|||
LengthLimit(6) = 2 |
|||
LengthLimit(7) = 1 |
|||
LengthLimit(8) = 0 |
|||
LengthLimit(9) = 0 |
|||
LengthLimit(10) = 0 |
|||
'reset word order |
|||
Shuffle |
|||
End Sub |
|||
'for fun plug-in of words |
|||
Sub pluggin (wdSS As String, x As Long, y As Long, d As Long) |
|||
For i As ULong = 0 To Len(wdSS) - 1 |
|||
LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1) |
|||
Next |
|||
WI += WI |
|||
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
End Sub |
|||
' Function TrmSS (n As Integer) As String |
|||
' TrmSS = RTrim(LTrim(Str(n))) |
|||
' End Function |
|||
'used in PlaceWord |
|||
Function CountSpaces () As ULong |
|||
Dim As ULong x, y, count |
|||
For y = 0 To 9 |
|||
For x = 0 To 9 |
|||
If LSS(x, y) = " " Then count += 1 |
|||
Next |
|||
Next |
|||
CountSpaces = count |
|||
End Function |
|||
Sub ShowPuzzle |
|||
Dim As ULong i, x, y |
|||
'Dim As String wateSS |
|||
Cls |
|||
Print " 0 1 2 3 4 5 6 7 8 9" |
|||
Locate 3, 1 |
|||
For i = 0 To 9 |
|||
Print TrmSS(i) |
|||
Next |
|||
For y = 0 To 9 |
|||
For x = 0 To 9 |
|||
Locate y + 3, 2 * x + 5: Print LSS(x, y) |
|||
Next |
|||
Next |
|||
For i = 1 To WI |
|||
If i < 21 Then |
|||
Locate i + 1, 30: Print TrmSS(i); " "; WSS(i) |
|||
ElseIf i < 41 Then |
|||
Locate i - 20 + 1, 45: Print TrmSS(i); " "; WSS(i) |
|||
ElseIf i < 61 Then |
|||
Locate i - 40 + 1, 60: Print TrmSS(i); " "; WSS(i) |
|||
End If |
|||
Next |
|||
Locate 18, 1: Print "Spaces left:"; CountSpaces |
|||
Locate 19, 1: Print NWORDS |
|||
Locate 20, 1: Print Space(16) |
|||
If WORDSINDEX Then Locate 20, 1: Print TrmSS(WORDSINDEX); " "; WORDSSS(WORDSINDEX) |
|||
'LOCATE 15, 1: INPUT "OK, press enter... "; wateSS |
|||
End Sub |
|||
'used in PlaceWord |
|||
Function Match (word As String, template As String) As Long |
|||
Dim i As ULong |
|||
Dim c As String |
|||
Match = 0 |
|||
If Len(word) <> Len(template) Then Exit Function |
|||
For i = 1 To Len(template) |
|||
If Asc(template, i) <> 32 And (Asc(word, i) <> Asc(template, i)) Then Exit Function |
|||
Next |
|||
Match = -1 |
|||
End Function |
|||
'heart of puzzle builder |
|||
Sub PlaceWord |
|||
' place the words randomly in the grid |
|||
' start at random spot and work forward or back 100 times = all the squares |
|||
' for each open square try the 8 directions for placing the word |
|||
' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE, |
|||
' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop |
|||
' if place a word update LSS, WI, WSS(WI), WX(WI), WY(WI), WD(WI) |
|||
Dim As String wdSS, templateSS |
|||
Dim As Long rdir |
|||
Dim As ULong wLen, spot, testNum |
|||
Dim As ULong x, y, d, dNum, rdd, i, j |
|||
Dim As Boolean b1, b2 |
|||
wdSS = WORDSSS(WORDSINDEX) ' the right side is all shared |
|||
' skip too many long words |
|||
If LengthLimit(Len(wdSS)) Then LengthLimit(Len(wdSS)) += 1 Else Exit Sub 'skip long ones |
|||
wLen = Len(wdSS) - 1 ' from the spot there are this many letters to check |
|||
spot = Int(Rnd * 100) ' a random spot on grid |
|||
testNum = 1 ' when this hits 100 we've tested all possible spots on grid |
|||
If Rnd < .5 Then rdir = -1 Else rdir = 1 ' go forward or back from spot for next test |
|||
While testNum < 101 |
|||
y = spot \ 10 |
|||
x = spot Mod 10 |
|||
If LSS(x, y) = Mid(wdSS, 1, 1) Or LSS(x, y) = " " Then |
|||
d = Int(8 * Rnd) |
|||
If Rnd < .5 Then rdd = -1 Else rdd = 1 |
|||
dNum = 1 |
|||
While dNum < 9 |
|||
'will wdSS fit? from at x, y |
|||
templateSS = "" |
|||
b1 = wLen * DX(d) + x >= 0 And wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 And wLen * DY(d) + y <= 9 |
|||
If b1 And b2 Then 'build the template of letters and spaces from Letter grid |
|||
For i = 0 To wLen |
|||
templateSS += LSS(x + i * DX(d), y + i * DY(d)) |
|||
Next |
|||
If Match(wdSS, templateSS) Then 'the word will fit but does it fill anything? |
|||
For j = 1 To Len(templateSS) |
|||
If Asc(templateSS, j) = 32 Then 'yes a space to fill |
|||
For i = 0 To wLen |
|||
LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1) |
|||
Next |
|||
WI += 1 |
|||
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
ShowPuzzle |
|||
If CountSpaces = 0 Then FILLED = TRUE |
|||
Exit Sub 'get out now that word is loaded |
|||
End If |
|||
Next |
|||
'if still here keep looking |
|||
End If |
|||
End If |
|||
d = (d + 8 + rdd) Mod 8 |
|||
dNum += 1 |
|||
Wend |
|||
End If |
|||
spot = (spot + 100 + rdir) Mod 100 |
|||
testNum += 1 |
|||
Wend |
|||
End Sub |
|||
Sub FindAllWords |
|||
Dim As String wdSS, templateSS, wateSS |
|||
Dim As ULong wLen, x, y, d, j |
|||
Dim As Boolean b1, b2 |
|||
For i As ULong = 1 To NWORDS |
|||
wdSS = CWORDSSS(i) |
|||
wLen = Len(wdSS) - 1 |
|||
For y = 0 To 9 |
|||
For x = 0 To 9 |
|||
If LSS(x, y) = Mid(wdSS, 1, 1) Then |
|||
For d = 0 To 7 |
|||
b1 = wLen * DX(d) + x >= 0 And wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 And wLen * DY(d) + y <= 9 |
|||
If b1 And b2 Then 'build the template of letters and spaces from Letter grid |
|||
templateSS = "" |
|||
For j = 0 To wLen |
|||
templateSS += LSS(x + j * DX(d), y + j * DY(d)) |
|||
Next |
|||
If templateSS = wdSS Then 'found a word |
|||
'store it |
|||
ALLindex += 1 |
|||
ALLSS(ALLindex) = wdSS: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d |
|||
'report it |
|||
Locate 22, 1: Print Space(50) |
|||
Locate 22, 1: Print "Found: "; wdSS; " ("; TrmSS(x); ", "; TrmSS(y); ") >>>---> "; TrmSS(d); |
|||
Input " Press enter...", wateSS |
|||
End If |
|||
End If |
|||
Next |
|||
End If |
|||
Next |
|||
Next |
|||
Next |
|||
End Sub |
|||
Sub FilePuzzle |
|||
Dim As ULong i, r, c, ff = FreeFile |
|||
Dim As String bSS |
|||
Open "WS Puzzle.txt" For Output As #ff |
|||
Print #ff, " 0 1 2 3 4 5 6 7 8 9" |
|||
Print #ff, |
|||
For r = 0 To 9 |
|||
bSS = TrmSS(r) + " " |
|||
For c = 0 To 9 |
|||
bSS += LSS(c, r) + " " |
|||
Next |
|||
Print #ff, bSS |
|||
Next |
|||
Print #ff, |
|||
Print #ff, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" |
|||
Print #ff, |
|||
Print #ff, " These are the items from unixdict.txt used to build the puzzle:" |
|||
Print #ff, |
|||
For i = 1 To WI Step 2 |
|||
Print #ff, Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + WSS(i), 10); " ("; TrmSS(WX(i)); ", "; TrmSS(WY(i)); ") >>>---> "; TrmSS(WD(i)); |
|||
If i + 1 <= WI Then |
|||
Print #ff, Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + WSS(i + 1), 10); " ("; TrmSS(WX(i + 1)); ", "; TrmSS(WY(i + 1)); ") >>>---> "; TrmSS(WD(i + 1)) |
|||
Else |
|||
Print #ff, |
|||
End If |
|||
Next |
|||
Print #ff, |
|||
Print #ff, " These are the items from unixdict.txt found embedded in the puzzle:" |
|||
Print #ff, |
|||
For i = 1 To ALLindex Step 2 |
|||
Print #ff, Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + ALLSS(i), 10); " ("; TrmSS(AllX(i)); ", "; TrmSS(AllY(i)); ") >>>---> "; TrmSS(AllD(i)); |
|||
If i + 1 <= ALLindex Then |
|||
Print #ff, Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + ALLSS(i + 1), 10); " ("; TrmSS(AllX(i + 1)); ", "; TrmSS(AllY(i + 1)); ") >>>---> "; TrmSS(AllD(i + 1)) |
|||
Else |
|||
Print #ff, "" |
|||
End If |
|||
Next |
|||
Print #ff, |
|||
Print #ff, "On try #" + TrmSS(try) + " a successful puzzle was built and filed." |
|||
Close #ff |
|||
End Sub |
|||
LoadWords 'this sets NWORDS count to work with |
|||
While try < 11 |
|||
Initialize |
|||
ShowPuzzle |
|||
For WORDSINDEX = 1 To NWORDS |
|||
PlaceWord |
|||
' ShowPuzzle |
|||
If FILLED Then Exit For |
|||
Next |
|||
If Not filled And WI > 24 Then ' we have 25 or more words |
|||
For y As ULong = 0 To 9 ' fill spaces with random letters |
|||
For x As ULong = 0 To 9 |
|||
If LSS(x, y) = " " Then LSS(x, y) = Chr(Int(Rnd * 26) + 1 + 96) |
|||
Next |
|||
Next |
|||
filled = TRUE |
|||
ShowPuzzle |
|||
End If |
|||
If FILLED And WI > 24 Then |
|||
FindAllWords |
|||
FilePuzzle |
|||
Locate 23, 1: Print "On try #"; TrmSS(try); " a successful puzzle was built and filed." |
|||
Exit While |
|||
Else |
|||
try += 1 |
|||
End If |
|||
Wend |
|||
If Not FILLED Then Locate 23, 1: Print "Sorry, 10 tries and no success." |
|||
Sleep |
|||
End</syntaxhighlight> |
|||
{{out}} |
|||
<pre style="height:52ex;overflow:scroll"> 0 1 2 3 4 5 6 7 8 9 |
|||
0 m g y m l a i r R u |
|||
1 s e u i o n n p s O |
|||
2 a p S l s s u n e n |
|||
3 h w o e l t j E a t |
|||
4 c T r l n a e i s T |
|||
5 c t e a c A r w i g |
|||
6 C w m m r b a i d a |
|||
7 O d s t u m b r e l |
|||
8 D o a i t h i g h h |
|||
9 l p E g d b o r h t |
|||
Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE |
|||
These are the items from unixdict.txt used to build the puzzle: |
|||
1) yea (2, 0) >>>---> 3 2) thigh (4, 8) >>>---> 0 |
|||
3) wells (1, 6) >>>---> 7 4) jacm (6, 3) >>>---> 3 |
|||
5) tumbrel (3, 7) >>>---> 0 6) mile (3, 0) >>>---> 2 |
|||
7) seaside (8, 1) >>>---> 2 8) putnam (7, 1) >>>---> 3 |
|||
9) throb (9, 9) >>>---> 4 10) insert (6, 0) >>>---> 3 |
|||
11) brian (5, 6) >>>---> 7 12) chasm (0, 4) >>>---> 6 |
|||
13) los (0, 9) >>>---> 7 14) aida (6, 6) >>>---> 0 |
|||
15) anna (5, 0) >>>---> 1 16) dis (4, 9) >>>---> 5 |
|||
17) heir (9, 8) >>>---> 5 18) lop (3, 4) >>>---> 5 |
|||
19) gull (1, 0) >>>---> 1 20) sol (4, 2) >>>---> 6 |
|||
21) gad (3, 9) >>>---> 5 22) stew (4, 2) >>>---> 1 |
|||
23) ncr (4, 4) >>>---> 2 24) pat (1, 9) >>>---> 7 |
|||
25) lair (4, 0) >>>---> 0 26) woe (1, 3) >>>---> 0 |
|||
27) pet (7, 1) >>>---> 1 28) usn (9, 0) >>>---> 3 |
|||
29) lag (9, 7) >>>---> 6 30) etc (2, 5) >>>---> 4 |
|||
These are the items from unixdict.txt found embedded in the puzzle: |
|||
1) acm (5, 4) >>>---> 3 2) aid (6, 6) >>>---> 0 |
|||
3) aida (6, 6) >>>---> 0 4) air (5, 0) >>>---> 0 |
|||
5) air (8, 3) >>>---> 3 6) ale (3, 5) >>>---> 6 |
|||
7) all (5, 4) >>>---> 5 8) ann (5, 0) >>>---> 1 |
|||
9) ann (8, 3) >>>---> 5 10) anna (5, 0) >>>---> 1 |
|||
11) anna (8, 3) >>>---> 5 12) ant (3, 5) >>>---> 7 |
|||
13) are (6, 6) >>>---> 6 14) arm (3, 5) >>>---> 1 |
|||
15) aside (8, 3) >>>---> 2 16) bar (6, 7) >>>---> 6 |
|||
17) bare (6, 7) >>>---> 6 18) bird (5, 9) >>>---> 7 |
|||
19) brian (5, 6) >>>---> 7 20) chasm (0, 4) >>>---> 6 |
|||
21) dis (8, 6) >>>---> 6 22) dis (4, 9) >>>---> 5 |
|||
23) drib (8, 6) >>>---> 3 24) ego (8, 7) >>>---> 3 |
|||
25) eli (3, 3) >>>---> 6 26) ell (2, 5) >>>---> 7 |
|||
27) era (6, 4) >>>---> 2 28) etc (2, 5) >>>---> 4 |
|||
29) gad (3, 9) >>>---> 5 30) gal (9, 5) >>>---> 2 |
|||
31) gull (1, 0) >>>---> 1 32) gym (1, 0) >>>---> 0 |
|||
33) heir (9, 8) >>>---> 5 34) high (5, 8) >>>---> 0 |
|||
35) hum (5, 8) >>>---> 5 36) ian (7, 4) >>>---> 7 |
|||
37) ida (7, 6) >>>---> 0 38) insert (6, 0) >>>---> 3 |
|||
39) ion (3, 1) >>>---> 0 40) ira (7, 6) >>>---> 5 |
|||
41) jacm (6, 3) >>>---> 3 42) lag (9, 7) >>>---> 6 |
|||
43) lair (4, 0) >>>---> 0 44) lam (3, 4) >>>---> 2 |
|||
45) leo (4, 3) >>>---> 4 46) lew (3, 4) >>>---> 3 |
|||
47) lim (3, 2) >>>---> 6 48) lop (3, 4) >>>---> 5 |
|||
49) los (4, 0) >>>---> 2 50) los (0, 9) >>>---> 7 |
|||
51) lug (3, 2) >>>---> 5 52) male (3, 6) >>>---> 6 |
|||
53) man (2, 6) >>>---> 7 54) maw (5, 7) >>>---> 7 |
|||
55) mile (3, 0) >>>---> 2 56) nair (9, 2) >>>---> 3 |
|||
57) ncr (4, 4) >>>---> 2 58) ore (2, 3) >>>---> 2 |
|||
59) pat (1, 9) >>>---> 7 60) peg (1, 2) >>>---> 6 |
|||
61) pet (7, 1) >>>---> 1 62) pod (1, 9) >>>---> 6 |
|||
63) pol (1, 2) >>>---> 1 64) put (7, 1) >>>---> 3 |
|||
65) putnam (7, 1) >>>---> 3 66) rib (7, 7) >>>---> 3 |
|||
67) rim (7, 9) >>>---> 5 68) rob (7, 9) >>>---> 4 |
|||
69) rut (4, 6) >>>---> 2 70) sea (8, 1) >>>---> 2 |
|||
71) seaside (8, 1) >>>---> 2 72) side (8, 4) >>>---> 2 |
|||
73) sol (4, 2) >>>---> 6 74) sol (2, 7) >>>---> 3 |
|||
75) stew (4, 2) >>>---> 1 76) stu (2, 7) >>>---> 0 |
|||
77) sun (5, 2) >>>---> 0 78) swam (8, 4) >>>---> 3 |
|||
79) tap (3, 7) >>>---> 3 80) tea (1, 5) >>>---> 0 |
|||
81) thigh (4, 8) >>>---> 0 82) throb (9, 9) >>>---> 4 |
|||
83) tum (3, 7) >>>---> 0 84) tumbrel (3, 7) >>>---> 0 |
|||
85) usn (9, 0) >>>---> 3 86) well (1, 6) >>>---> 7 |
|||
87) wells (1, 6) >>>---> 7 88) wet (7, 5) >>>---> 5 |
|||
89) wig (7, 5) >>>---> 0 90) woe (1, 3) >>>---> 0 |
|||
91) yea (2, 0) >>>---> 3 |
|||
On try #1 a successful puzzle was built and filed.</pre> |
|||
==={{header|QB64}}=== |
|||
''bplus'': 2020/03/13 |
|||
The following zip file is needed for the Unix dictionary and a QB64 words mod for fun! ...and some samples.<br> |
|||
[https://www.qb64.org/forum/index.php?action=dlattach;topic=2334.0;attach=5434 Rosetta Code Word Search Challenge.zip] |
|||
<syntaxhighlight lang="qbasic"> OPTION _EXPLICIT |
|||
_TITLE "Puzzle Builder for Rosetta" 'by B+ started 2018-10-31 |
|||
' 2018-11-02 Now that puzzle is working with basic and plus starters remove them and make sure puzzle works as well. |
|||
' Added Direction legend to printout. |
|||
' OverHauled LengthLimit() |
|||
' Reorgnize this to try a couple of times at given Randomize number |
|||
' TODO create alphabetical copy of word list and check grid for all words embedded in it. |
|||
' LoadWords makes a copy of word list in alpha order |
|||
' FindAllWords finds all the items from the dictionary |
|||
' OK it all seems to be working OK |
|||
RANDOMIZE TIMER ' OK getting a good puzzle every time |
|||
'overhauled |
|||
DIM SHARED LengthLimit(3 TO 10) AS _BYTE 'reset in Initialize, track and limit longer words |
|||
'LoadWords opens file of words and sets |
|||
DIM SHARED NWORDS 'set in LoadWords, number of words with length: > 2 and < 11 and just letters |
|||
' word file words (shuffled) to be fit into puzzle and index position |
|||
DIM SHARED WORDS$(1 TO 24945), CWORDS$(1 TO 24945), WORDSINDEX AS INTEGER 'the file has 24945 words but many are unsuitable |
|||
'words placed in Letters grid, word itself (W$) x, y head (WX, WY) and direction (WD), WI is the index to all these |
|||
DIM SHARED W$(1 TO 100), WX(1 TO 100) AS _BYTE, WY(1 TO 100) AS _BYTE, WD(1 TO 100) AS _BYTE, WI AS _BYTE |
|||
' letters grid and direction arrays |
|||
DIM SHARED L$(0 TO 9, 0 TO 9), DX(0 TO 7) AS _BYTE, DY(0 TO 7) AS _BYTE |
|||
DX(0) = 1: DY(0) = 0 |
|||
DX(1) = 1: DY(1) = 1 |
|||
DX(2) = 0: DY(2) = 1 |
|||
DX(3) = -1: DY(3) = 1 |
|||
DX(4) = -1: DY(4) = 0 |
|||
DX(5) = -1: DY(5) = -1 |
|||
DX(6) = 0: DY(6) = -1 |
|||
DX(7) = 1: DY(7) = -1 |
|||
'to store all the words found embedded in the grid L$() |
|||
DIM SHARED ALL$(1 TO 200), AllX(1 TO 200) AS _BYTE, AllY(1 TO 200) AS _BYTE, AllD(1 TO 200) AS _BYTE 'to store all the words found embedded in the grid L$() |
|||
DIM SHARED ALLindex AS INTEGER |
|||
' signal successful fill of puzzle |
|||
DIM SHARED FILLED AS _BIT |
|||
FILLED = 0 |
|||
DIM try AS _BYTE |
|||
try = 1 |
|||
LoadWords 'this sets NWORDS count to work with |
|||
WHILE try < 11 |
|||
Initialize |
|||
ShowPuzzle |
|||
FOR WORDSINDEX = 1 TO NWORDS |
|||
PlaceWord |
|||
ShowPuzzle |
|||
IF FILLED THEN EXIT FOR |
|||
NEXT |
|||
IF FILLED AND WI > 24 THEN |
|||
FindAllWords |
|||
FilePuzzle |
|||
LOCATE 23, 1: PRINT "On try #"; Trm$(try); " a successful puzzle was built and filed." |
|||
EXIT WHILE |
|||
ELSE |
|||
try = try + 1 |
|||
END IF |
|||
WEND |
|||
IF FILLED = 0 THEN LOCATE 23, 1: PRINT "Sorry, 10 tries and no success." |
|||
END |
|||
SUB LoadWords |
|||
DIM wd$, i AS INTEGER, m AS INTEGER, ok AS _BIT |
|||
OPEN "unixdict.txt" FOR INPUT AS #1 |
|||
WHILE EOF(1) = 0 |
|||
INPUT #1, wd$ |
|||
IF LEN(wd$) > 2 AND LEN(wd$) < 11 THEN |
|||
ok = -1 |
|||
FOR m = 1 TO LEN(wd$) |
|||
IF ASC(wd$, m) < 97 OR ASC(wd$, m) > 122 THEN ok = 0: EXIT FOR |
|||
NEXT |
|||
IF ok THEN i = i + 1: WORDS$(i) = wd$: CWORDS$(i) = wd$ |
|||
END IF |
|||
WEND |
|||
CLOSE #1 |
|||
NWORDS = i |
|||
END SUB |
|||
SUB Shuffle |
|||
DIM i AS INTEGER, r AS INTEGER |
|||
FOR i = NWORDS TO 2 STEP -1 |
|||
r = INT(RND * i) + 1 |
|||
SWAP WORDS$(i), WORDS$(r) |
|||
NEXT |
|||
END SUB |
|||
SUB Initialize |
|||
DIM r AS _BYTE, c AS _BYTE, x AS _BYTE, y AS _BYTE, d AS _BYTE, wd$ |
|||
FOR r = 0 TO 9 |
|||
FOR c = 0 TO 9 |
|||
L$(c, r) = " " |
|||
NEXT |
|||
NEXT |
|||
'reset word arrays by resetting the word index back to zero |
|||
WI = 0 |
|||
'fun stuff for me but doubt others would like that much fun! |
|||
'pluggin "basic", 0, 0, 2 |
|||
'pluggin "plus", 1, 0, 0 |
|||
'to assure the spreading of ROSETTA CODE |
|||
L$(INT(RND * 5) + 5, 0) = "R": L$(INT(RND * 9) + 1, 1) = "O" |
|||
L$(INT(RND * 9) + 1, 2) = "S": L$(INT(RND * 9) + 1, 3) = "E" |
|||
L$(1, 4) = "T": L$(9, 4) = "T": L$(INT(10 * RND), 5) = "A" |
|||
L$(INT(10 * RND), 6) = "C": L$(INT(10 * RND), 7) = "O" |
|||
L$(INT(10 * RND), 8) = "D": L$(INT(10 * RND), 9) = "E" |
|||
'reset limits |
|||
LengthLimit(3) = 200 |
|||
LengthLimit(4) = 6 |
|||
LengthLimit(5) = 3 |
|||
LengthLimit(6) = 2 |
|||
LengthLimit(7) = 1 |
|||
LengthLimit(8) = 0 |
|||
LengthLimit(9) = 0 |
|||
LengthLimit(10) = 0 |
|||
'reset word order |
|||
Shuffle |
|||
END SUB |
|||
'for fun plug-in of words |
|||
SUB pluggin (wd$, x AS INTEGER, y AS INTEGER, d AS INTEGER) |
|||
DIM i AS _BYTE |
|||
FOR i = 0 TO LEN(wd$) - 1 |
|||
L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1) |
|||
NEXT |
|||
WI = WI + 1 |
|||
W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
END SUB |
|||
FUNCTION Trm$ (n AS INTEGER) |
|||
Trm$ = RTRIM$(LTRIM$(STR$(n))) |
|||
END FUNCTION |
|||
SUB ShowPuzzle |
|||
DIM i AS _BYTE, x AS _BYTE, y AS _BYTE, wate$ |
|||
CLS |
|||
PRINT " 0 1 2 3 4 5 6 7 8 9" |
|||
LOCATE 3, 1 |
|||
FOR i = 0 TO 9 |
|||
PRINT Trm$(i) |
|||
NEXT |
|||
FOR y = 0 TO 9 |
|||
FOR x = 0 TO 9 |
|||
LOCATE y + 3, 2 * x + 5: PRINT L$(x, y) |
|||
NEXT |
|||
NEXT |
|||
FOR i = 1 TO WI |
|||
IF i < 20 THEN |
|||
LOCATE i + 1, 30: PRINT Trm$(i); " "; W$(i) |
|||
ELSEIF i < 40 THEN |
|||
LOCATE i - 20 + 1, 45: PRINT Trm$(i); " "; W$(i) |
|||
ELSEIF i < 60 THEN |
|||
LOCATE i - 40 + 1, 60: PRINT Trm$(i); " "; W$(i) |
|||
END IF |
|||
NEXT |
|||
LOCATE 18, 1: PRINT "Spaces left:"; CountSpaces% |
|||
LOCATE 19, 1: PRINT NWORDS |
|||
LOCATE 20, 1: PRINT SPACE$(16) |
|||
IF WORDSINDEX THEN LOCATE 20, 1: PRINT Trm$(WORDSINDEX); " "; WORDS$(WORDSINDEX) |
|||
'LOCATE 15, 1: INPUT "OK, press enter... "; wate$ |
|||
END SUB |
|||
'used in PlaceWord |
|||
FUNCTION CountSpaces% () |
|||
DIM x AS _BYTE, y AS _BYTE, count AS INTEGER |
|||
FOR y = 0 TO 9 |
|||
FOR x = 0 TO 9 |
|||
IF L$(x, y) = " " THEN count = count + 1 |
|||
NEXT |
|||
NEXT |
|||
CountSpaces% = count |
|||
END FUNCTION |
|||
'used in PlaceWord |
|||
FUNCTION Match% (word AS STRING, template AS STRING) |
|||
DIM i AS INTEGER, c AS STRING |
|||
Match% = 0 |
|||
IF LEN(word) <> LEN(template) THEN EXIT FUNCTION |
|||
FOR i = 1 TO LEN(template) |
|||
IF ASC(template, i) <> 32 AND (ASC(word, i) <> ASC(template, i)) THEN EXIT FUNCTION |
|||
NEXT |
|||
Match% = -1 |
|||
END FUNCTION |
|||
'heart of puzzle builder |
|||
SUB PlaceWord |
|||
' place the words randomly in the grid |
|||
' start at random spot and work forward or back 100 times = all the squares |
|||
' for each open square try the 8 directions for placing the word |
|||
' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE, |
|||
' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop |
|||
' if place a word update L$, WI, W$(WI), WX(WI), WY(WI), WD(WI) |
|||
DIM wd$, wLen AS _BYTE, spot AS _BYTE, testNum AS _BYTE, rdir AS _BYTE |
|||
DIM x AS _BYTE, y AS _BYTE, d AS _BYTE, dNum AS _BYTE, rdd AS _BYTE |
|||
DIM template$, b1 AS _BIT, b2 AS _BIT |
|||
DIM i AS _BYTE, j AS _BYTE, wate$ |
|||
wd$ = WORDS$(WORDSINDEX) 'the right side is all shared |
|||
'skip too many long words |
|||
IF LengthLimit(LEN(wd$)) THEN LengthLimit(LEN(wd$)) = LengthLimit(LEN(wd$)) - 1 ELSE EXIT SUB 'skip long ones |
|||
wLen = LEN(wd$) - 1 ' from the spot there are this many letters to check |
|||
spot = INT(RND * 100) ' a random spot on grid |
|||
testNum = 1 ' when this hits 100 we've tested all possible spots on grid |
|||
IF RND < .5 THEN rdir = -1 ELSE rdir = 1 ' go forward or back from spot for next test |
|||
WHILE testNum < 101 |
|||
y = INT(spot / 10) |
|||
x = spot MOD 10 |
|||
IF L$(x, y) = MID$(wd$, 1, 1) OR L$(x, y) = " " THEN |
|||
d = INT(8 * RND) |
|||
IF RND < .5 THEN rdd = -1 ELSE rdd = 1 |
|||
dNum = 1 |
|||
WHILE dNum < 9 |
|||
'will wd$ fit? from at x, y |
|||
template$ = "" |
|||
b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9 |
|||
IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid |
|||
FOR i = 0 TO wLen |
|||
template$ = template$ + L$(x + i * DX(d), y + i * DY(d)) |
|||
NEXT |
|||
IF Match%(wd$, template$) THEN 'the word will fit but does it fill anything? |
|||
FOR j = 1 TO LEN(template$) |
|||
IF ASC(template$, j) = 32 THEN 'yes a space to fill |
|||
FOR i = 0 TO wLen |
|||
L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1) |
|||
NEXT |
|||
WI = WI + 1 |
|||
W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
IF CountSpaces% = 0 THEN FILLED = -1 |
|||
EXIT SUB 'get out now that word is loaded |
|||
END IF |
|||
NEXT |
|||
'if still here keep looking |
|||
END IF |
|||
END IF |
|||
d = (d + 8 + rdd) MOD 8 |
|||
dNum = dNum + 1 |
|||
WEND |
|||
END IF |
|||
spot = (spot + 100 + rdir) MOD 100 |
|||
testNum = testNum + 1 |
|||
WEND |
|||
END SUB |
|||
SUB FindAllWords |
|||
DIM wd$, wLen AS _BYTE, i AS INTEGER, x AS _BYTE, y AS _BYTE, d AS _BYTE |
|||
DIM template$, b1 AS _BIT, b2 AS _BIT, j AS _BYTE, wate$ |
|||
FOR i = 1 TO NWORDS |
|||
wd$ = CWORDS$(i) |
|||
wLen = LEN(wd$) - 1 |
|||
FOR y = 0 TO 9 |
|||
FOR x = 0 TO 9 |
|||
IF L$(x, y) = MID$(wd$, 1, 1) THEN |
|||
FOR d = 0 TO 7 |
|||
b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9 |
|||
IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid |
|||
template$ = "" |
|||
FOR j = 0 TO wLen |
|||
template$ = template$ + L$(x + j * DX(d), y + j * DY(d)) |
|||
NEXT |
|||
IF template$ = wd$ THEN 'founda word |
|||
'store it |
|||
ALLindex = ALLindex + 1 |
|||
ALL$(ALLindex) = wd$: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d |
|||
'report it |
|||
LOCATE 22, 1: PRINT SPACE$(50) |
|||
LOCATE 22, 1: PRINT "Found: "; wd$; " ("; Trm$(x); ", "; Trm$(y); ") >>>---> "; Trm$(d); |
|||
INPUT " Press enter...", wate$ |
|||
END IF |
|||
END IF |
|||
NEXT d |
|||
END IF |
|||
NEXT x |
|||
NEXT y |
|||
NEXT i |
|||
END SUB |
|||
SUB FilePuzzle |
|||
DIM i AS _BYTE, r AS _BYTE, c AS _BYTE, b$ |
|||
OPEN "WS Puzzle.txt" FOR OUTPUT AS #1 |
|||
PRINT #1, " 0 1 2 3 4 5 6 7 8 9" |
|||
PRINT #1, "" |
|||
FOR r = 0 TO 9 |
|||
b$ = Trm$(r) + " " |
|||
FOR c = 0 TO 9 |
|||
b$ = b$ + L$(c, r) + " " |
|||
NEXT |
|||
PRINT #1, b$ |
|||
NEXT |
|||
PRINT #1, "" |
|||
PRINT #1, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" |
|||
PRINT #1, "" |
|||
PRINT #1, " These are the items from unixdict.txt used to build the puzzle:" |
|||
PRINT #1, "" |
|||
FOR i = 1 TO WI STEP 2 |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + W$(i), 10); " ("; Trm$(WX(i)); ", "; Trm$(WY(i)); ") >>>---> "; Trm$(WD(i)); |
|||
IF i + 1 <= WI THEN |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + W$(i + 1), 10); " ("; Trm$(WX(i + 1)); ", "; Trm$(WY(i + 1)); ") >>>---> "; Trm$(WD(i + 1)) |
|||
ELSE |
|||
PRINT #1, "" |
|||
END IF |
|||
NEXT |
|||
PRINT #1, "" |
|||
PRINT #1, " These are the items from unixdict.txt found embedded in the puzzle:" |
|||
PRINT #1, "" |
|||
FOR i = 1 TO ALLindex STEP 2 |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i), 10); " ("; Trm$(AllX(i)); ", "; Trm$(AllY(i)); ") >>>---> "; Trm$(AllD(i)); |
|||
IF i + 1 <= ALLindex THEN |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i + 1), 10); " ("; Trm$(AllX(i + 1)); ", "; Trm$(AllY(i + 1)); ") >>>---> "; Trm$(AllD(i + 1)) |
|||
ELSE |
|||
PRINT #1, "" |
|||
END IF |
|||
NEXT |
|||
CLOSE #1 |
|||
END SUB</syntaxhighlight> |
|||
---- |
|||
'''Sample Output:''' |
|||
<br><br><code> |
|||
0 1 2 3 4 5 6 7 8 9 <br> |
|||
0 t g a m m R l b a r <br> |
|||
1 o e O k y u i l u b <br> |
|||
2 l S e e n n i o a t <br> |
|||
3 s a g d E u i d e w <br> |
|||
4 k T c t e h g s a T <br> |
|||
5 s e n o j b o A e r <br> |
|||
6 C l g n c o a p g r <br> |
|||
7 l i o d i u m u e O <br> |
|||
8 k a e r f D d y c t <br> |
|||
9 t j E a i d r a p h <br></code> |
|||
<br>Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE<br> |
|||
<br> |
|||
These are the items from unixdict.txt used to build the puzzle: |
|||
1) odium (2, 7) >>>---> 0 2) resiny (9, 6) >>>---> 5 |
|||
3) debauch (3, 3) >>>---> 1 4) freak (4, 8) >>>---> 4 |
|||
5) jones (4, 5) >>>---> 4 6) radium (9, 5) >>>---> 5 |
|||
7) hope (5, 4) >>>---> 1 8) coca (4, 6) >>>---> 5 |
|||
9) slot (0, 3) >>>---> 6 10) aid (3, 9) >>>---> 0 |
|||
11) gunk (6, 4) >>>---> 5 12) keg (0, 4) >>>---> 1 |
|||
13) aile (1, 8) >>>---> 6 14) set (7, 4) >>>---> 7 |
|||
15) wall (9, 3) >>>---> 5 16) rye (6, 9) >>>---> 7 |
|||
17) our (7, 2) >>>---> 7 18) bar (7, 0) >>>---> 0 |
|||
19) par (8, 9) >>>---> 4 20) gam (1, 0) >>>---> 0 |
|||
21) dee (3, 3) >>>---> 5 22) ton (3, 4) >>>---> 2 |
|||
23) dab (7, 3) >>>---> 7 24) jed (1, 9) >>>---> 7 |
|||
25) bin (7, 0) >>>---> 3 26) pet (7, 6) >>>---> 1 |
|||
27) sag (0, 3) >>>---> 0 28) nco (3, 6) >>>---> 0 |
|||
29) dug (6, 8) >>>---> 7 30) oat (2, 7) >>>---> 3 |
|||
31) oil (2, 7) >>>---> 4 32) nee (4, 2) >>>---> 4 |
|||
These are the items from unixdict.txt found embedded in the puzzle:<br> |
|||
1) abe (6, 6) >>>---> 5 2) abed (6, 6) >>>---> 5 |
|||
3) aid (3, 9) >>>---> 0 4) ail (1, 8) >>>---> 6 |
|||
5) aile (1, 8) >>>---> 6 6) ali (8, 0) >>>---> 3 |
|||
7) all (8, 2) >>>---> 5 8) bad (9, 1) >>>---> 3 |
|||
9) bar (7, 0) >>>---> 0 10) bed (5, 5) >>>---> 5 |
|||
11) bin (7, 0) >>>---> 3 12) but (7, 0) >>>---> 1 |
|||
13) cal (2, 4) >>>---> 5 14) coca (4, 6) >>>---> 5 |
|||
15) cud (4, 6) >>>---> 1 16) dab (7, 3) >>>---> 7 |
|||
17) dar (7, 3) >>>---> 1 18) debauch (3, 3) >>>---> 1 |
|||
19) dee (3, 3) >>>---> 5 20) dew (7, 3) >>>---> 0 |
|||
21) dug (6, 8) >>>---> 7 22) edt (3, 2) >>>---> 2 |
|||
23) eli (1, 5) >>>---> 2 24) etc (4, 4) >>>---> 4 |
|||
25) freak (4, 8) >>>---> 4 26) gam (1, 0) >>>---> 0 |
|||
27) gas (2, 3) >>>---> 4 28) goa (6, 4) >>>---> 2 |
|||
29) gsa (6, 4) >>>---> 0 30) gun (6, 4) >>>---> 5 |
|||
31) gunk (6, 4) >>>---> 5 32) hop (5, 4) >>>---> 1 |
|||
33) hope (5, 4) >>>---> 1 34) hun (5, 4) >>>---> 6 |
|||
35) ida (6, 2) >>>---> 1 36) iii (6, 1) >>>---> 2 |
|||
37) iii (6, 3) >>>---> 6 38) inn (6, 2) >>>---> 4 |
|||
39) inn (4, 7) >>>---> 5 40) jail (1, 9) >>>---> 6 |
|||
41) jed (1, 9) >>>---> 7 42) jon (4, 5) >>>---> 4 |
|||
43) jones (4, 5) >>>---> 4 44) keg (0, 4) >>>---> 1 |
|||
45) lac (0, 2) >>>---> 1 46) law (7, 1) >>>---> 1 |
|||
47) lea (0, 2) >>>---> 7 48) lot (0, 2) >>>---> 6 |
|||
49) lund (6, 0) >>>---> 3 50) mao (6, 7) >>>---> 6 |
|||
51) nco (3, 6) >>>---> 0 52) nee (4, 2) >>>---> 4 |
|||
53) nib (5, 2) >>>---> 7 54) nne (5, 2) >>>---> 4 |
|||
55) not (3, 6) >>>---> 6 56) oat (7, 2) >>>---> 0 |
|||
57) oat (2, 7) >>>---> 3 58) odium (2, 7) >>>---> 0 |
|||
59) oil (2, 7) >>>---> 4 60) one (3, 5) >>>---> 4 |
|||
61) our (7, 2) >>>---> 7 62) par (8, 9) >>>---> 4 |
|||
63) pet (7, 6) >>>---> 1 64) radium (9, 5) >>>---> 5 |
|||
65) rap (6, 9) >>>---> 0 66) resin (9, 6) >>>---> 5 |
|||
67) resiny (9, 6) >>>---> 5 68) rio (3, 8) >>>---> 7 |
|||
69) rye (6, 9) >>>---> 7 70) sag (0, 3) >>>---> 0 |
|||
71) sen (0, 5) >>>---> 0 72) set (7, 4) >>>---> 7 |
|||
73) sin (7, 4) >>>---> 5 74) slot (0, 3) >>>---> 6 |
|||
75) tao (9, 2) >>>---> 4 76) tao (0, 9) >>>---> 7 |
|||
77) tee (0, 0) >>>---> 1 78) ton (3, 4) >>>---> 2 |
|||
79) tub (9, 2) >>>---> 5 80) wall (9, 3) >>>---> 5 |
|||
81) wed (9, 3) >>>---> 4 |
|||
<br> |
|||
==={{header|Visual Basic .NET}}=== |
|||
{{trans|C#}} |
|||
<syntaxhighlight lang="vbnet">Module Module1 |
|||
ReadOnly Dirs As Integer(,) = { |
|||
{1, 0}, {0, 1}, {1, 1}, |
|||
{1, -1}, {-1, 0}, |
|||
{0, -1}, {-1, -1}, {-1, 1} |
|||
} |
|||
Const RowCount = 10 |
|||
Const ColCount = 10 |
|||
Const GridSize = RowCount * ColCount |
|||
Const MinWords = 25 |
|||
Class Grid |
|||
Public cells(RowCount - 1, ColCount - 1) As Char |
|||
Public solutions As New List(Of String) |
|||
Public numAttempts As Integer |
|||
Sub New() |
|||
For i = 0 To RowCount - 1 |
|||
For j = 0 To ColCount - 1 |
|||
cells(i, j) = ControlChars.NullChar |
|||
Next |
|||
Next |
|||
End Sub |
|||
End Class |
|||
Dim Rand As New Random() |
|||
Sub Main() |
|||
PrintResult(CreateWordSearch(ReadWords("unixdict.txt"))) |
|||
End Sub |
|||
Function ReadWords(filename As String) As List(Of String) |
|||
Dim maxlen = Math.Max(RowCount, ColCount) |
|||
Dim words As New List(Of String) |
|||
Dim objReader As New IO.StreamReader(filename) |
|||
Dim line As String |
|||
Do While objReader.Peek() <> -1 |
|||
line = objReader.ReadLine() |
|||
If line.Length > 3 And line.Length < maxlen Then |
|||
If line.All(Function(c) Char.IsLetter(c)) Then |
|||
words.Add(line) |
|||
End If |
|||
End If |
|||
Loop |
|||
Return words |
|||
End Function |
|||
Function CreateWordSearch(words As List(Of String)) As Grid |
|||
For numAttempts = 1 To 1000 |
|||
Shuffle(words) |
|||
Dim grid As New Grid() |
|||
Dim messageLen = PlaceMessage(grid, "Rosetta Code") |
|||
Dim target = GridSize - messageLen |
|||
Dim cellsFilled = 0 |
|||
For Each word In words |
|||
cellsFilled = cellsFilled + TryPlaceWord(grid, word) |
|||
If cellsFilled = target Then |
|||
If grid.solutions.Count >= MinWords Then |
|||
grid.numAttempts = numAttempts |
|||
Return grid |
|||
Else |
|||
'grid is full but we didn't pack enough words, start over |
|||
Exit For |
|||
End If |
|||
End If |
|||
Next |
|||
Next |
|||
Return Nothing |
|||
End Function |
|||
Function PlaceMessage(grid As Grid, msg As String) As Integer |
|||
msg = msg.ToUpper() |
|||
msg = msg.Replace(" ", "") |
|||
If msg.Length > 0 And msg.Length < GridSize Then |
|||
Dim gapSize As Integer = GridSize / msg.Length |
|||
Dim pos = 0 |
|||
Dim lastPos = -1 |
|||
For i = 0 To msg.Length - 1 |
|||
If i = 0 Then |
|||
pos = pos + Rand.Next(gapSize - 1) |
|||
Else |
|||
pos = pos + Rand.Next(2, gapSize - 1) |
|||
End If |
|||
Dim r As Integer = Math.Floor(pos / ColCount) |
|||
Dim c = pos Mod ColCount |
|||
grid.cells(r, c) = msg(i) |
|||
lastPos = pos |
|||
Next |
|||
Return msg.Length |
|||
End If |
|||
Return 0 |
|||
End Function |
|||
Function TryPlaceWord(grid As Grid, word As String) As Integer |
|||
Dim randDir = Rand.Next(Dirs.GetLength(0)) |
|||
Dim randPos = Rand.Next(GridSize) |
|||
For d = 0 To Dirs.GetLength(0) - 1 |
|||
Dim dd = (d + randDir) Mod Dirs.GetLength(0) |
|||
For p = 0 To GridSize - 1 |
|||
Dim pp = (p + randPos) Mod GridSize |
|||
Dim lettersPLaced = TryLocation(grid, word, dd, pp) |
|||
If lettersPLaced > 0 Then |
|||
Return lettersPLaced |
|||
End If |
|||
Next |
|||
Next |
|||
Return 0 |
|||
End Function |
|||
Function TryLocation(grid As Grid, word As String, dir As Integer, pos As Integer) As Integer |
|||
Dim r As Integer = pos / ColCount |
|||
Dim c = pos Mod ColCount |
|||
Dim len = word.Length |
|||
'check bounds |
|||
If (Dirs(dir, 0) = 1 And len + c >= ColCount) Or (Dirs(dir, 0) = -1 And len - 1 > c) Or (Dirs(dir, 1) = 1 And len + r >= RowCount) Or (Dirs(dir, 1) = -1 And len - 1 > r) Then |
|||
Return 0 |
|||
End If |
|||
If r = RowCount OrElse c = ColCount Then |
|||
Return 0 |
|||
End If |
|||
Dim rr = r |
|||
Dim cc = c |
|||
'check cells |
|||
For i = 0 To len - 1 |
|||
If grid.cells(rr, cc) <> ControlChars.NullChar AndAlso grid.cells(rr, cc) <> word(i) Then |
|||
Return 0 |
|||
End If |
|||
cc = cc + Dirs(dir, 0) |
|||
rr = rr + Dirs(dir, 1) |
|||
Next |
|||
'place |
|||
Dim overlaps = 0 |
|||
rr = r |
|||
cc = c |
|||
For i = 0 To len - 1 |
|||
If grid.cells(rr, cc) = word(i) Then |
|||
overlaps = overlaps + 1 |
|||
Else |
|||
grid.cells(rr, cc) = word(i) |
|||
End If |
|||
If i < len - 1 Then |
|||
cc = cc + Dirs(dir, 0) |
|||
rr = rr + Dirs(dir, 1) |
|||
End If |
|||
Next |
|||
Dim lettersPlaced = len - overlaps |
|||
If lettersPlaced > 0 Then |
|||
grid.solutions.Add(String.Format("{0,-10} ({1},{2})({3},{4})", word, c, r, cc, rr)) |
|||
End If |
|||
Return lettersPlaced |
|||
End Function |
|||
Sub PrintResult(grid As Grid) |
|||
If IsNothing(grid) OrElse grid.numAttempts = 0 Then |
|||
Console.WriteLine("No grid to display") |
|||
Return |
|||
End If |
|||
Console.WriteLine("Attempts: {0}", grid.numAttempts) |
|||
Console.WriteLine("Number of words: {0}", GridSize) |
|||
Console.WriteLine() |
|||
Console.WriteLine(" 0 1 2 3 4 5 6 7 8 9") |
|||
For r = 0 To RowCount - 1 |
|||
Console.WriteLine() |
|||
Console.Write("{0} ", r) |
|||
For c = 0 To ColCount - 1 |
|||
Console.Write(" {0} ", grid.cells(r, c)) |
|||
Next |
|||
Next |
|||
Console.WriteLine() |
|||
Console.WriteLine() |
|||
For i = 0 To grid.solutions.Count - 1 |
|||
If i Mod 2 = 0 Then |
|||
Console.Write("{0}", grid.solutions(i)) |
|||
Else |
|||
Console.WriteLine(" {0}", grid.solutions(i)) |
|||
End If |
|||
Next |
|||
Console.WriteLine() |
|||
End Sub |
|||
'taken from https://stackoverflow.com/a/20449161 |
|||
Sub Shuffle(Of T)(list As IList(Of T)) |
|||
Dim r As Random = New Random() |
|||
For i = 0 To list.Count - 1 |
|||
Dim index As Integer = r.Next(i, list.Count) |
|||
If i <> index Then |
|||
' swap list(i) and list(index) |
|||
Dim temp As T = list(i) |
|||
list(i) = list(index) |
|||
list(index) = temp |
|||
End If |
|||
Next |
|||
End Sub |
|||
End Module</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Attempts: 148 |
|||
Number of words: 100 |
|||
0 1 2 3 4 5 6 7 8 9 |
|||
0 c d p R e c h a r e |
|||
1 O i u b a k e S l v |
|||
2 k n l E m c a c a i |
|||
3 T e s i T x A s n t |
|||
4 t C e s a l O a g a |
|||
5 a j D l l e E h l g |
|||
6 l u f e m a h s e r |
|||
7 l t c a r f e r y u |
|||
8 f e r r e i r a m p |
|||
9 f a m i l i s m i s |
|||
refract (7,7)(1,7) shameful (7,6)(0,6) |
|||
ferreira (0,8)(7,8) familism (0,9)(7,9) |
|||
langley (8,1)(8,7) sake (7,3)(4,0) |
|||
pulse (2,0)(2,4) purgative (9,8)(9,0) |
|||
cacm (7,2)(4,2) enid (1,3)(1,0) |
|||
char (5,0)(8,0) flax (2,6)(5,3) |
|||
tall (0,4)(0,7) isle (3,3)(3,6) |
|||
jute (1,5)(1,8) myel (8,8)(8,5) |
|||
bake (3,1)(6,1) cell (2,7)(5,4) |
|||
marsh (7,9)(7,5) keel (0,2)(3,5) |
|||
spur (9,9)(9,6) leaf (5,4)(5,7) |
|||
cilia (0,0)(4,4) sims (9,9)(6,9) |
|||
marsha (7,9)(7,4)</pre> |
|||
=={{header|C sharp}}== |
=={{header|C sharp}}== |
||
Line 911: | Line 2,032: | ||
yon (2,7)(0,9) ell (6,9)(4,7) |
yon (2,7)(0,9) ell (6,9)(4,7) |
||
gig (5,3)(3,1) yea (0,1)(2,1)</pre> |
gig (5,3)(3,1) yea (0,1)(2,1)</pre> |
||
=={{header|FreeBASIC}}== |
|||
{{trans|QB64}} |
|||
Changes: |
|||
ShowPuzzle gets call only after a word is inserted in the grid. |
|||
Added a check if unixdict.txt was found. |
|||
Made FilePuzzle print to the file. |
|||
If enough words are found but there where still spaces, fill them with random letters. |
|||
FILLED was not set to FALSE every time Initialize was called. |
|||
Set all integer to (U)long. |
|||
<syntaxhighlight lang="freebasic">Randomize Timer ' OK getting a good puzzle every time |
|||
#Macro TrmSS (n) |
|||
LTrim(Str(n)) |
|||
#EndMacro |
|||
'overhauled |
|||
Dim Shared As ULong LengthLimit(3 To 10) 'reset in Initialize, track and limit longer words |
|||
'LoadWords opens file of words and sets |
|||
Dim Shared As ULong NWORDS 'set in LoadWords, number of words with length: > 2 and < 11 and just letters |
|||
' word file words (shuffled) to be fit into puzzle and index position |
|||
Dim Shared As String WORDSSS(1 To 24945), CWORDSSS(1 To 24945) |
|||
Dim Shared As ULong WORDSINDEX 'the file has 24945 words but many are unsuitable |
|||
'words placed in Letters grid, word itself (WSS) x, y head (WX, WY) and direction (WD), WI is the index to all these |
|||
Dim Shared As String WSS(1 To 100) |
|||
Dim Shared As ULong WX(1 To 100), WY(1 To 100), WD(1 To 100), WI |
|||
' letters grid and direction arrays |
|||
Dim Shared As String LSS(0 To 9, 0 To 9) |
|||
Dim Shared As Long DX(0 To 7), DY(0 To 7) |
|||
DX(0) = 1: DY(0) = 0 |
|||
DX(1) = 1: DY(1) = 1 |
|||
DX(2) = 0: DY(2) = 1 |
|||
DX(3) = -1: DY(3) = 1 |
|||
DX(4) = -1: DY(4) = 0 |
|||
DX(5) = -1: DY(5) = -1 |
|||
DX(6) = 0: DY(6) = -1 |
|||
DX(7) = 1: DY(7) = -1 |
|||
'to store all the words found embedded in the grid LSS() |
|||
Dim Shared As String ALLSS(1 To 200) |
|||
Dim Shared As ULong AllX(1 To 200), AllY(1 To 200), AllD(1 To 200) 'to store all the words found embedded in the grid LSS() |
|||
Dim Shared As ULong ALLindex |
|||
' signal successful fill of puzzle |
|||
Dim Shared FILLED As Boolean |
|||
Dim Shared As ULong try = 1 |
|||
Sub LoadWords |
|||
Dim As String wdSS |
|||
Dim As ULong i, m, ff = FreeFile |
|||
Dim ok As Boolean |
|||
Open "unixdict.txt" For Input As #ff |
|||
If Err > 0 Then |
|||
Print !"\n unixdict.txt not found, program will end" |
|||
Sleep 5000 |
|||
End |
|||
End If |
|||
While Eof(1) = 0 |
|||
Input #ff, wdSS |
|||
If Len(wdSS) > 2 And Len(wdSS) < 11 Then |
|||
ok = TRUE |
|||
For m = 1 To Len(wdSS) |
|||
If Asc(wdSS, m) < 97 Or Asc(wdSS, m) > 122 Then ok = FALSE: Exit For |
|||
Next |
|||
If ok Then i += 1: WORDSSS(i) = wdSS: CWORDSSS(i) = wdSS |
|||
End If |
|||
Wend |
|||
Close #ff |
|||
NWORDS = i |
|||
End Sub |
|||
Sub Shuffle |
|||
Dim As ULong i, r |
|||
For i = NWORDS To 2 Step -1 |
|||
r = Int(Rnd * i) + 1 |
|||
Swap WORDSSS(i), WORDSSS(r) |
|||
Next |
|||
End Sub |
|||
Sub Initialize |
|||
Dim As ULong r, c'', x, y, d |
|||
Dim As String wdSS |
|||
FILLED = FALSE |
|||
For r = 0 To 9 |
|||
For c = 0 To 9 |
|||
LSS(c, r) = " " |
|||
Next |
|||
Next |
|||
'reset word arrays by resetting the word index back to zero |
|||
WI = 0 |
|||
'fun stuff for me but doubt others would like that much fun! |
|||
'pluggin "basic", 0, 0, 2 |
|||
'pluggin "plus", 1, 0, 0 |
|||
'to assure the spreading of ROSETTA CODE |
|||
LSS(Int(Rnd * 5) + 5, 0) = "R": LSS(Int(Rnd * 9) + 1, 1) = "O" |
|||
LSS(Int(Rnd * 9) + 1, 2) = "S": LSS(Int(Rnd * 9) + 1, 3) = "E" |
|||
LSS(1, 4) = "T": LSS(9, 4) = "T": LSS(Int(10 * Rnd), 5) = "A" |
|||
LSS(Int(10 * Rnd), 6) = "C": LSS(Int(10 * Rnd), 7) = "O" |
|||
LSS(Int(10 * Rnd), 8) = "D": LSS(Int(10 * Rnd), 9) = "E" |
|||
'reset limits |
|||
LengthLimit(3) = 200 |
|||
LengthLimit(4) = 6 |
|||
LengthLimit(5) = 3 |
|||
LengthLimit(6) = 2 |
|||
LengthLimit(7) = 1 |
|||
LengthLimit(8) = 0 |
|||
LengthLimit(9) = 0 |
|||
LengthLimit(10) = 0 |
|||
'reset word order |
|||
Shuffle |
|||
End Sub |
|||
'for fun plug-in of words |
|||
Sub pluggin (wdSS As String, x As Long, y As Long, d As Long) |
|||
For i As ULong = 0 To Len(wdSS) - 1 |
|||
LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1) |
|||
Next |
|||
WI += WI |
|||
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
End Sub |
|||
' Function TrmSS (n As Integer) As String |
|||
' TrmSS = RTrim(LTrim(Str(n))) |
|||
' End Function |
|||
'used in PlaceWord |
|||
Function CountSpaces () As ULong |
|||
Dim As ULong x, y, count |
|||
For y = 0 To 9 |
|||
For x = 0 To 9 |
|||
If LSS(x, y) = " " Then count += 1 |
|||
Next |
|||
Next |
|||
CountSpaces = count |
|||
End Function |
|||
Sub ShowPuzzle |
|||
Dim As ULong i, x, y |
|||
'Dim As String wateSS |
|||
Cls |
|||
Print " 0 1 2 3 4 5 6 7 8 9" |
|||
Locate 3, 1 |
|||
For i = 0 To 9 |
|||
Print TrmSS(i) |
|||
Next |
|||
For y = 0 To 9 |
|||
For x = 0 To 9 |
|||
Locate y + 3, 2 * x + 5: Print LSS(x, y) |
|||
Next |
|||
Next |
|||
For i = 1 To WI |
|||
If i < 21 Then |
|||
Locate i + 1, 30: Print TrmSS(i); " "; WSS(i) |
|||
ElseIf i < 41 Then |
|||
Locate i - 20 + 1, 45: Print TrmSS(i); " "; WSS(i) |
|||
ElseIf i < 61 Then |
|||
Locate i - 40 + 1, 60: Print TrmSS(i); " "; WSS(i) |
|||
End If |
|||
Next |
|||
Locate 18, 1: Print "Spaces left:"; CountSpaces |
|||
Locate 19, 1: Print NWORDS |
|||
Locate 20, 1: Print Space(16) |
|||
If WORDSINDEX Then Locate 20, 1: Print TrmSS(WORDSINDEX); " "; WORDSSS(WORDSINDEX) |
|||
'LOCATE 15, 1: INPUT "OK, press enter... "; wateSS |
|||
End Sub |
|||
'used in PlaceWord |
|||
Function Match (word As String, template As String) As Long |
|||
Dim i As ULong |
|||
Dim c As String |
|||
Match = 0 |
|||
If Len(word) <> Len(template) Then Exit Function |
|||
For i = 1 To Len(template) |
|||
If Asc(template, i) <> 32 And (Asc(word, i) <> Asc(template, i)) Then Exit Function |
|||
Next |
|||
Match = -1 |
|||
End Function |
|||
'heart of puzzle builder |
|||
Sub PlaceWord |
|||
' place the words randomly in the grid |
|||
' start at random spot and work forward or back 100 times = all the squares |
|||
' for each open square try the 8 directions for placing the word |
|||
' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE, |
|||
' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop |
|||
' if place a word update LSS, WI, WSS(WI), WX(WI), WY(WI), WD(WI) |
|||
Dim As String wdSS, templateSS |
|||
Dim As Long rdir |
|||
Dim As ULong wLen, spot, testNum |
|||
Dim As ULong x, y, d, dNum, rdd, i, j |
|||
Dim As Boolean b1, b2 |
|||
wdSS = WORDSSS(WORDSINDEX) ' the right side is all shared |
|||
' skip too many long words |
|||
If LengthLimit(Len(wdSS)) Then LengthLimit(Len(wdSS)) += 1 Else Exit Sub 'skip long ones |
|||
wLen = Len(wdSS) - 1 ' from the spot there are this many letters to check |
|||
spot = Int(Rnd * 100) ' a random spot on grid |
|||
testNum = 1 ' when this hits 100 we've tested all possible spots on grid |
|||
If Rnd < .5 Then rdir = -1 Else rdir = 1 ' go forward or back from spot for next test |
|||
While testNum < 101 |
|||
y = spot \ 10 |
|||
x = spot Mod 10 |
|||
If LSS(x, y) = Mid(wdSS, 1, 1) Or LSS(x, y) = " " Then |
|||
d = Int(8 * Rnd) |
|||
If Rnd < .5 Then rdd = -1 Else rdd = 1 |
|||
dNum = 1 |
|||
While dNum < 9 |
|||
'will wdSS fit? from at x, y |
|||
templateSS = "" |
|||
b1 = wLen * DX(d) + x >= 0 And wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 And wLen * DY(d) + y <= 9 |
|||
If b1 And b2 Then 'build the template of letters and spaces from Letter grid |
|||
For i = 0 To wLen |
|||
templateSS += LSS(x + i * DX(d), y + i * DY(d)) |
|||
Next |
|||
If Match(wdSS, templateSS) Then 'the word will fit but does it fill anything? |
|||
For j = 1 To Len(templateSS) |
|||
If Asc(templateSS, j) = 32 Then 'yes a space to fill |
|||
For i = 0 To wLen |
|||
LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1) |
|||
Next |
|||
WI += 1 |
|||
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
ShowPuzzle |
|||
If CountSpaces = 0 Then FILLED = TRUE |
|||
Exit Sub 'get out now that word is loaded |
|||
End If |
|||
Next |
|||
'if still here keep looking |
|||
End If |
|||
End If |
|||
d = (d + 8 + rdd) Mod 8 |
|||
dNum += 1 |
|||
Wend |
|||
End If |
|||
spot = (spot + 100 + rdir) Mod 100 |
|||
testNum += 1 |
|||
Wend |
|||
End Sub |
|||
Sub FindAllWords |
|||
Dim As String wdSS, templateSS, wateSS |
|||
Dim As ULong wLen, x, y, d, j |
|||
Dim As Boolean b1, b2 |
|||
For i As ULong = 1 To NWORDS |
|||
wdSS = CWORDSSS(i) |
|||
wLen = Len(wdSS) - 1 |
|||
For y = 0 To 9 |
|||
For x = 0 To 9 |
|||
If LSS(x, y) = Mid(wdSS, 1, 1) Then |
|||
For d = 0 To 7 |
|||
b1 = wLen * DX(d) + x >= 0 And wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 And wLen * DY(d) + y <= 9 |
|||
If b1 And b2 Then 'build the template of letters and spaces from Letter grid |
|||
templateSS = "" |
|||
For j = 0 To wLen |
|||
templateSS += LSS(x + j * DX(d), y + j * DY(d)) |
|||
Next |
|||
If templateSS = wdSS Then 'found a word |
|||
'store it |
|||
ALLindex += 1 |
|||
ALLSS(ALLindex) = wdSS: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d |
|||
'report it |
|||
Locate 22, 1: Print Space(50) |
|||
Locate 22, 1: Print "Found: "; wdSS; " ("; TrmSS(x); ", "; TrmSS(y); ") >>>---> "; TrmSS(d); |
|||
Input " Press enter...", wateSS |
|||
End If |
|||
End If |
|||
Next |
|||
End If |
|||
Next |
|||
Next |
|||
Next |
|||
End Sub |
|||
Sub FilePuzzle |
|||
Dim As ULong i, r, c, ff = FreeFile |
|||
Dim As String bSS |
|||
Open "WS Puzzle.txt" For Output As #ff |
|||
Print #ff, " 0 1 2 3 4 5 6 7 8 9" |
|||
Print #ff, |
|||
For r = 0 To 9 |
|||
bSS = TrmSS(r) + " " |
|||
For c = 0 To 9 |
|||
bSS += LSS(c, r) + " " |
|||
Next |
|||
Print #ff, bSS |
|||
Next |
|||
Print #ff, |
|||
Print #ff, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" |
|||
Print #ff, |
|||
Print #ff, " These are the items from unixdict.txt used to build the puzzle:" |
|||
Print #ff, |
|||
For i = 1 To WI Step 2 |
|||
Print #ff, Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + WSS(i), 10); " ("; TrmSS(WX(i)); ", "; TrmSS(WY(i)); ") >>>---> "; TrmSS(WD(i)); |
|||
If i + 1 <= WI Then |
|||
Print #ff, Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + WSS(i + 1), 10); " ("; TrmSS(WX(i + 1)); ", "; TrmSS(WY(i + 1)); ") >>>---> "; TrmSS(WD(i + 1)) |
|||
Else |
|||
Print #ff, |
|||
End If |
|||
Next |
|||
Print #ff, |
|||
Print #ff, " These are the items from unixdict.txt found embedded in the puzzle:" |
|||
Print #ff, |
|||
For i = 1 To ALLindex Step 2 |
|||
Print #ff, Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + ALLSS(i), 10); " ("; TrmSS(AllX(i)); ", "; TrmSS(AllY(i)); ") >>>---> "; TrmSS(AllD(i)); |
|||
If i + 1 <= ALLindex Then |
|||
Print #ff, Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + ALLSS(i + 1), 10); " ("; TrmSS(AllX(i + 1)); ", "; TrmSS(AllY(i + 1)); ") >>>---> "; TrmSS(AllD(i + 1)) |
|||
Else |
|||
Print #ff, "" |
|||
End If |
|||
Next |
|||
Print #ff, |
|||
Print #ff, "On try #" + TrmSS(try) + " a successful puzzle was built and filed." |
|||
Close #ff |
|||
End Sub |
|||
LoadWords 'this sets NWORDS count to work with |
|||
While try < 11 |
|||
Initialize |
|||
ShowPuzzle |
|||
For WORDSINDEX = 1 To NWORDS |
|||
PlaceWord |
|||
' ShowPuzzle |
|||
If FILLED Then Exit For |
|||
Next |
|||
If Not filled And WI > 24 Then ' we have 25 or more words |
|||
For y As ULong = 0 To 9 ' fill spaces with random letters |
|||
For x As ULong = 0 To 9 |
|||
If LSS(x, y) = " " Then LSS(x, y) = Chr(Int(Rnd * 26) + 1 + 96) |
|||
Next |
|||
Next |
|||
filled = TRUE |
|||
ShowPuzzle |
|||
End If |
|||
If FILLED And WI > 24 Then |
|||
FindAllWords |
|||
FilePuzzle |
|||
Locate 23, 1: Print "On try #"; TrmSS(try); " a successful puzzle was built and filed." |
|||
Exit While |
|||
Else |
|||
try += 1 |
|||
End If |
|||
Wend |
|||
If Not FILLED Then Locate 23, 1: Print "Sorry, 10 tries and no success." |
|||
Sleep |
|||
End</syntaxhighlight> |
|||
{{out}} |
|||
<pre style="height:52ex;overflow:scroll"> 0 1 2 3 4 5 6 7 8 9 |
|||
0 m g y m l a i r R u |
|||
1 s e u i o n n p s O |
|||
2 a p S l s s u n e n |
|||
3 h w o e l t j E a t |
|||
4 c T r l n a e i s T |
|||
5 c t e a c A r w i g |
|||
6 C w m m r b a i d a |
|||
7 O d s t u m b r e l |
|||
8 D o a i t h i g h h |
|||
9 l p E g d b o r h t |
|||
Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE |
|||
These are the items from unixdict.txt used to build the puzzle: |
|||
1) yea (2, 0) >>>---> 3 2) thigh (4, 8) >>>---> 0 |
|||
3) wells (1, 6) >>>---> 7 4) jacm (6, 3) >>>---> 3 |
|||
5) tumbrel (3, 7) >>>---> 0 6) mile (3, 0) >>>---> 2 |
|||
7) seaside (8, 1) >>>---> 2 8) putnam (7, 1) >>>---> 3 |
|||
9) throb (9, 9) >>>---> 4 10) insert (6, 0) >>>---> 3 |
|||
11) brian (5, 6) >>>---> 7 12) chasm (0, 4) >>>---> 6 |
|||
13) los (0, 9) >>>---> 7 14) aida (6, 6) >>>---> 0 |
|||
15) anna (5, 0) >>>---> 1 16) dis (4, 9) >>>---> 5 |
|||
17) heir (9, 8) >>>---> 5 18) lop (3, 4) >>>---> 5 |
|||
19) gull (1, 0) >>>---> 1 20) sol (4, 2) >>>---> 6 |
|||
21) gad (3, 9) >>>---> 5 22) stew (4, 2) >>>---> 1 |
|||
23) ncr (4, 4) >>>---> 2 24) pat (1, 9) >>>---> 7 |
|||
25) lair (4, 0) >>>---> 0 26) woe (1, 3) >>>---> 0 |
|||
27) pet (7, 1) >>>---> 1 28) usn (9, 0) >>>---> 3 |
|||
29) lag (9, 7) >>>---> 6 30) etc (2, 5) >>>---> 4 |
|||
These are the items from unixdict.txt found embedded in the puzzle: |
|||
1) acm (5, 4) >>>---> 3 2) aid (6, 6) >>>---> 0 |
|||
3) aida (6, 6) >>>---> 0 4) air (5, 0) >>>---> 0 |
|||
5) air (8, 3) >>>---> 3 6) ale (3, 5) >>>---> 6 |
|||
7) all (5, 4) >>>---> 5 8) ann (5, 0) >>>---> 1 |
|||
9) ann (8, 3) >>>---> 5 10) anna (5, 0) >>>---> 1 |
|||
11) anna (8, 3) >>>---> 5 12) ant (3, 5) >>>---> 7 |
|||
13) are (6, 6) >>>---> 6 14) arm (3, 5) >>>---> 1 |
|||
15) aside (8, 3) >>>---> 2 16) bar (6, 7) >>>---> 6 |
|||
17) bare (6, 7) >>>---> 6 18) bird (5, 9) >>>---> 7 |
|||
19) brian (5, 6) >>>---> 7 20) chasm (0, 4) >>>---> 6 |
|||
21) dis (8, 6) >>>---> 6 22) dis (4, 9) >>>---> 5 |
|||
23) drib (8, 6) >>>---> 3 24) ego (8, 7) >>>---> 3 |
|||
25) eli (3, 3) >>>---> 6 26) ell (2, 5) >>>---> 7 |
|||
27) era (6, 4) >>>---> 2 28) etc (2, 5) >>>---> 4 |
|||
29) gad (3, 9) >>>---> 5 30) gal (9, 5) >>>---> 2 |
|||
31) gull (1, 0) >>>---> 1 32) gym (1, 0) >>>---> 0 |
|||
33) heir (9, 8) >>>---> 5 34) high (5, 8) >>>---> 0 |
|||
35) hum (5, 8) >>>---> 5 36) ian (7, 4) >>>---> 7 |
|||
37) ida (7, 6) >>>---> 0 38) insert (6, 0) >>>---> 3 |
|||
39) ion (3, 1) >>>---> 0 40) ira (7, 6) >>>---> 5 |
|||
41) jacm (6, 3) >>>---> 3 42) lag (9, 7) >>>---> 6 |
|||
43) lair (4, 0) >>>---> 0 44) lam (3, 4) >>>---> 2 |
|||
45) leo (4, 3) >>>---> 4 46) lew (3, 4) >>>---> 3 |
|||
47) lim (3, 2) >>>---> 6 48) lop (3, 4) >>>---> 5 |
|||
49) los (4, 0) >>>---> 2 50) los (0, 9) >>>---> 7 |
|||
51) lug (3, 2) >>>---> 5 52) male (3, 6) >>>---> 6 |
|||
53) man (2, 6) >>>---> 7 54) maw (5, 7) >>>---> 7 |
|||
55) mile (3, 0) >>>---> 2 56) nair (9, 2) >>>---> 3 |
|||
57) ncr (4, 4) >>>---> 2 58) ore (2, 3) >>>---> 2 |
|||
59) pat (1, 9) >>>---> 7 60) peg (1, 2) >>>---> 6 |
|||
61) pet (7, 1) >>>---> 1 62) pod (1, 9) >>>---> 6 |
|||
63) pol (1, 2) >>>---> 1 64) put (7, 1) >>>---> 3 |
|||
65) putnam (7, 1) >>>---> 3 66) rib (7, 7) >>>---> 3 |
|||
67) rim (7, 9) >>>---> 5 68) rob (7, 9) >>>---> 4 |
|||
69) rut (4, 6) >>>---> 2 70) sea (8, 1) >>>---> 2 |
|||
71) seaside (8, 1) >>>---> 2 72) side (8, 4) >>>---> 2 |
|||
73) sol (4, 2) >>>---> 6 74) sol (2, 7) >>>---> 3 |
|||
75) stew (4, 2) >>>---> 1 76) stu (2, 7) >>>---> 0 |
|||
77) sun (5, 2) >>>---> 0 78) swam (8, 4) >>>---> 3 |
|||
79) tap (3, 7) >>>---> 3 80) tea (1, 5) >>>---> 0 |
|||
81) thigh (4, 8) >>>---> 0 82) throb (9, 9) >>>---> 4 |
|||
83) tum (3, 7) >>>---> 0 84) tumbrel (3, 7) >>>---> 0 |
|||
85) usn (9, 0) >>>---> 3 86) well (1, 6) >>>---> 7 |
|||
87) wells (1, 6) >>>---> 7 88) wet (7, 5) >>>---> 5 |
|||
89) wig (7, 5) >>>---> 0 90) woe (1, 3) >>>---> 0 |
|||
91) yea (2, 0) >>>---> 3 |
|||
On try #1 a successful puzzle was built and filed.</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
Line 2,903: | Line 3,570: | ||
dip (7,6)(9,8) |
dip (7,6)(9,8) |
||
</pre> |
</pre> |
||
=={{header|QB64}}== |
|||
''bplus'': 2020/03/13 |
|||
The following zip file is needed for the Unix dictionary and a QB64 words mod for fun! ...and some samples.<br> |
|||
[https://www.qb64.org/forum/index.php?action=dlattach;topic=2334.0;attach=5434 Rosetta Code Word Search Challenge.zip] |
|||
<syntaxhighlight lang="qbasic"> OPTION _EXPLICIT |
|||
_TITLE "Puzzle Builder for Rosetta" 'by B+ started 2018-10-31 |
|||
' 2018-11-02 Now that puzzle is working with basic and plus starters remove them and make sure puzzle works as well. |
|||
' Added Direction legend to printout. |
|||
' OverHauled LengthLimit() |
|||
' Reorgnize this to try a couple of times at given Randomize number |
|||
' TODO create alphabetical copy of word list and check grid for all words embedded in it. |
|||
' LoadWords makes a copy of word list in alpha order |
|||
' FindAllWords finds all the items from the dictionary |
|||
' OK it all seems to be working OK |
|||
RANDOMIZE TIMER ' OK getting a good puzzle every time |
|||
'overhauled |
|||
DIM SHARED LengthLimit(3 TO 10) AS _BYTE 'reset in Initialize, track and limit longer words |
|||
'LoadWords opens file of words and sets |
|||
DIM SHARED NWORDS 'set in LoadWords, number of words with length: > 2 and < 11 and just letters |
|||
' word file words (shuffled) to be fit into puzzle and index position |
|||
DIM SHARED WORDS$(1 TO 24945), CWORDS$(1 TO 24945), WORDSINDEX AS INTEGER 'the file has 24945 words but many are unsuitable |
|||
'words placed in Letters grid, word itself (W$) x, y head (WX, WY) and direction (WD), WI is the index to all these |
|||
DIM SHARED W$(1 TO 100), WX(1 TO 100) AS _BYTE, WY(1 TO 100) AS _BYTE, WD(1 TO 100) AS _BYTE, WI AS _BYTE |
|||
' letters grid and direction arrays |
|||
DIM SHARED L$(0 TO 9, 0 TO 9), DX(0 TO 7) AS _BYTE, DY(0 TO 7) AS _BYTE |
|||
DX(0) = 1: DY(0) = 0 |
|||
DX(1) = 1: DY(1) = 1 |
|||
DX(2) = 0: DY(2) = 1 |
|||
DX(3) = -1: DY(3) = 1 |
|||
DX(4) = -1: DY(4) = 0 |
|||
DX(5) = -1: DY(5) = -1 |
|||
DX(6) = 0: DY(6) = -1 |
|||
DX(7) = 1: DY(7) = -1 |
|||
'to store all the words found embedded in the grid L$() |
|||
DIM SHARED ALL$(1 TO 200), AllX(1 TO 200) AS _BYTE, AllY(1 TO 200) AS _BYTE, AllD(1 TO 200) AS _BYTE 'to store all the words found embedded in the grid L$() |
|||
DIM SHARED ALLindex AS INTEGER |
|||
' signal successful fill of puzzle |
|||
DIM SHARED FILLED AS _BIT |
|||
FILLED = 0 |
|||
DIM try AS _BYTE |
|||
try = 1 |
|||
LoadWords 'this sets NWORDS count to work with |
|||
WHILE try < 11 |
|||
Initialize |
|||
ShowPuzzle |
|||
FOR WORDSINDEX = 1 TO NWORDS |
|||
PlaceWord |
|||
ShowPuzzle |
|||
IF FILLED THEN EXIT FOR |
|||
NEXT |
|||
IF FILLED AND WI > 24 THEN |
|||
FindAllWords |
|||
FilePuzzle |
|||
LOCATE 23, 1: PRINT "On try #"; Trm$(try); " a successful puzzle was built and filed." |
|||
EXIT WHILE |
|||
ELSE |
|||
try = try + 1 |
|||
END IF |
|||
WEND |
|||
IF FILLED = 0 THEN LOCATE 23, 1: PRINT "Sorry, 10 tries and no success." |
|||
END |
|||
SUB LoadWords |
|||
DIM wd$, i AS INTEGER, m AS INTEGER, ok AS _BIT |
|||
OPEN "unixdict.txt" FOR INPUT AS #1 |
|||
WHILE EOF(1) = 0 |
|||
INPUT #1, wd$ |
|||
IF LEN(wd$) > 2 AND LEN(wd$) < 11 THEN |
|||
ok = -1 |
|||
FOR m = 1 TO LEN(wd$) |
|||
IF ASC(wd$, m) < 97 OR ASC(wd$, m) > 122 THEN ok = 0: EXIT FOR |
|||
NEXT |
|||
IF ok THEN i = i + 1: WORDS$(i) = wd$: CWORDS$(i) = wd$ |
|||
END IF |
|||
WEND |
|||
CLOSE #1 |
|||
NWORDS = i |
|||
END SUB |
|||
SUB Shuffle |
|||
DIM i AS INTEGER, r AS INTEGER |
|||
FOR i = NWORDS TO 2 STEP -1 |
|||
r = INT(RND * i) + 1 |
|||
SWAP WORDS$(i), WORDS$(r) |
|||
NEXT |
|||
END SUB |
|||
SUB Initialize |
|||
DIM r AS _BYTE, c AS _BYTE, x AS _BYTE, y AS _BYTE, d AS _BYTE, wd$ |
|||
FOR r = 0 TO 9 |
|||
FOR c = 0 TO 9 |
|||
L$(c, r) = " " |
|||
NEXT |
|||
NEXT |
|||
'reset word arrays by resetting the word index back to zero |
|||
WI = 0 |
|||
'fun stuff for me but doubt others would like that much fun! |
|||
'pluggin "basic", 0, 0, 2 |
|||
'pluggin "plus", 1, 0, 0 |
|||
'to assure the spreading of ROSETTA CODE |
|||
L$(INT(RND * 5) + 5, 0) = "R": L$(INT(RND * 9) + 1, 1) = "O" |
|||
L$(INT(RND * 9) + 1, 2) = "S": L$(INT(RND * 9) + 1, 3) = "E" |
|||
L$(1, 4) = "T": L$(9, 4) = "T": L$(INT(10 * RND), 5) = "A" |
|||
L$(INT(10 * RND), 6) = "C": L$(INT(10 * RND), 7) = "O" |
|||
L$(INT(10 * RND), 8) = "D": L$(INT(10 * RND), 9) = "E" |
|||
'reset limits |
|||
LengthLimit(3) = 200 |
|||
LengthLimit(4) = 6 |
|||
LengthLimit(5) = 3 |
|||
LengthLimit(6) = 2 |
|||
LengthLimit(7) = 1 |
|||
LengthLimit(8) = 0 |
|||
LengthLimit(9) = 0 |
|||
LengthLimit(10) = 0 |
|||
'reset word order |
|||
Shuffle |
|||
END SUB |
|||
'for fun plug-in of words |
|||
SUB pluggin (wd$, x AS INTEGER, y AS INTEGER, d AS INTEGER) |
|||
DIM i AS _BYTE |
|||
FOR i = 0 TO LEN(wd$) - 1 |
|||
L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1) |
|||
NEXT |
|||
WI = WI + 1 |
|||
W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
END SUB |
|||
FUNCTION Trm$ (n AS INTEGER) |
|||
Trm$ = RTRIM$(LTRIM$(STR$(n))) |
|||
END FUNCTION |
|||
SUB ShowPuzzle |
|||
DIM i AS _BYTE, x AS _BYTE, y AS _BYTE, wate$ |
|||
CLS |
|||
PRINT " 0 1 2 3 4 5 6 7 8 9" |
|||
LOCATE 3, 1 |
|||
FOR i = 0 TO 9 |
|||
PRINT Trm$(i) |
|||
NEXT |
|||
FOR y = 0 TO 9 |
|||
FOR x = 0 TO 9 |
|||
LOCATE y + 3, 2 * x + 5: PRINT L$(x, y) |
|||
NEXT |
|||
NEXT |
|||
FOR i = 1 TO WI |
|||
IF i < 20 THEN |
|||
LOCATE i + 1, 30: PRINT Trm$(i); " "; W$(i) |
|||
ELSEIF i < 40 THEN |
|||
LOCATE i - 20 + 1, 45: PRINT Trm$(i); " "; W$(i) |
|||
ELSEIF i < 60 THEN |
|||
LOCATE i - 40 + 1, 60: PRINT Trm$(i); " "; W$(i) |
|||
END IF |
|||
NEXT |
|||
LOCATE 18, 1: PRINT "Spaces left:"; CountSpaces% |
|||
LOCATE 19, 1: PRINT NWORDS |
|||
LOCATE 20, 1: PRINT SPACE$(16) |
|||
IF WORDSINDEX THEN LOCATE 20, 1: PRINT Trm$(WORDSINDEX); " "; WORDS$(WORDSINDEX) |
|||
'LOCATE 15, 1: INPUT "OK, press enter... "; wate$ |
|||
END SUB |
|||
'used in PlaceWord |
|||
FUNCTION CountSpaces% () |
|||
DIM x AS _BYTE, y AS _BYTE, count AS INTEGER |
|||
FOR y = 0 TO 9 |
|||
FOR x = 0 TO 9 |
|||
IF L$(x, y) = " " THEN count = count + 1 |
|||
NEXT |
|||
NEXT |
|||
CountSpaces% = count |
|||
END FUNCTION |
|||
'used in PlaceWord |
|||
FUNCTION Match% (word AS STRING, template AS STRING) |
|||
DIM i AS INTEGER, c AS STRING |
|||
Match% = 0 |
|||
IF LEN(word) <> LEN(template) THEN EXIT FUNCTION |
|||
FOR i = 1 TO LEN(template) |
|||
IF ASC(template, i) <> 32 AND (ASC(word, i) <> ASC(template, i)) THEN EXIT FUNCTION |
|||
NEXT |
|||
Match% = -1 |
|||
END FUNCTION |
|||
'heart of puzzle builder |
|||
SUB PlaceWord |
|||
' place the words randomly in the grid |
|||
' start at random spot and work forward or back 100 times = all the squares |
|||
' for each open square try the 8 directions for placing the word |
|||
' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE, |
|||
' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop |
|||
' if place a word update L$, WI, W$(WI), WX(WI), WY(WI), WD(WI) |
|||
DIM wd$, wLen AS _BYTE, spot AS _BYTE, testNum AS _BYTE, rdir AS _BYTE |
|||
DIM x AS _BYTE, y AS _BYTE, d AS _BYTE, dNum AS _BYTE, rdd AS _BYTE |
|||
DIM template$, b1 AS _BIT, b2 AS _BIT |
|||
DIM i AS _BYTE, j AS _BYTE, wate$ |
|||
wd$ = WORDS$(WORDSINDEX) 'the right side is all shared |
|||
'skip too many long words |
|||
IF LengthLimit(LEN(wd$)) THEN LengthLimit(LEN(wd$)) = LengthLimit(LEN(wd$)) - 1 ELSE EXIT SUB 'skip long ones |
|||
wLen = LEN(wd$) - 1 ' from the spot there are this many letters to check |
|||
spot = INT(RND * 100) ' a random spot on grid |
|||
testNum = 1 ' when this hits 100 we've tested all possible spots on grid |
|||
IF RND < .5 THEN rdir = -1 ELSE rdir = 1 ' go forward or back from spot for next test |
|||
WHILE testNum < 101 |
|||
y = INT(spot / 10) |
|||
x = spot MOD 10 |
|||
IF L$(x, y) = MID$(wd$, 1, 1) OR L$(x, y) = " " THEN |
|||
d = INT(8 * RND) |
|||
IF RND < .5 THEN rdd = -1 ELSE rdd = 1 |
|||
dNum = 1 |
|||
WHILE dNum < 9 |
|||
'will wd$ fit? from at x, y |
|||
template$ = "" |
|||
b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9 |
|||
IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid |
|||
FOR i = 0 TO wLen |
|||
template$ = template$ + L$(x + i * DX(d), y + i * DY(d)) |
|||
NEXT |
|||
IF Match%(wd$, template$) THEN 'the word will fit but does it fill anything? |
|||
FOR j = 1 TO LEN(template$) |
|||
IF ASC(template$, j) = 32 THEN 'yes a space to fill |
|||
FOR i = 0 TO wLen |
|||
L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1) |
|||
NEXT |
|||
WI = WI + 1 |
|||
W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d |
|||
IF CountSpaces% = 0 THEN FILLED = -1 |
|||
EXIT SUB 'get out now that word is loaded |
|||
END IF |
|||
NEXT |
|||
'if still here keep looking |
|||
END IF |
|||
END IF |
|||
d = (d + 8 + rdd) MOD 8 |
|||
dNum = dNum + 1 |
|||
WEND |
|||
END IF |
|||
spot = (spot + 100 + rdir) MOD 100 |
|||
testNum = testNum + 1 |
|||
WEND |
|||
END SUB |
|||
SUB FindAllWords |
|||
DIM wd$, wLen AS _BYTE, i AS INTEGER, x AS _BYTE, y AS _BYTE, d AS _BYTE |
|||
DIM template$, b1 AS _BIT, b2 AS _BIT, j AS _BYTE, wate$ |
|||
FOR i = 1 TO NWORDS |
|||
wd$ = CWORDS$(i) |
|||
wLen = LEN(wd$) - 1 |
|||
FOR y = 0 TO 9 |
|||
FOR x = 0 TO 9 |
|||
IF L$(x, y) = MID$(wd$, 1, 1) THEN |
|||
FOR d = 0 TO 7 |
|||
b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9 |
|||
b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9 |
|||
IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid |
|||
template$ = "" |
|||
FOR j = 0 TO wLen |
|||
template$ = template$ + L$(x + j * DX(d), y + j * DY(d)) |
|||
NEXT |
|||
IF template$ = wd$ THEN 'founda word |
|||
'store it |
|||
ALLindex = ALLindex + 1 |
|||
ALL$(ALLindex) = wd$: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d |
|||
'report it |
|||
LOCATE 22, 1: PRINT SPACE$(50) |
|||
LOCATE 22, 1: PRINT "Found: "; wd$; " ("; Trm$(x); ", "; Trm$(y); ") >>>---> "; Trm$(d); |
|||
INPUT " Press enter...", wate$ |
|||
END IF |
|||
END IF |
|||
NEXT d |
|||
END IF |
|||
NEXT x |
|||
NEXT y |
|||
NEXT i |
|||
END SUB |
|||
SUB FilePuzzle |
|||
DIM i AS _BYTE, r AS _BYTE, c AS _BYTE, b$ |
|||
OPEN "WS Puzzle.txt" FOR OUTPUT AS #1 |
|||
PRINT #1, " 0 1 2 3 4 5 6 7 8 9" |
|||
PRINT #1, "" |
|||
FOR r = 0 TO 9 |
|||
b$ = Trm$(r) + " " |
|||
FOR c = 0 TO 9 |
|||
b$ = b$ + L$(c, r) + " " |
|||
NEXT |
|||
PRINT #1, b$ |
|||
NEXT |
|||
PRINT #1, "" |
|||
PRINT #1, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" |
|||
PRINT #1, "" |
|||
PRINT #1, " These are the items from unixdict.txt used to build the puzzle:" |
|||
PRINT #1, "" |
|||
FOR i = 1 TO WI STEP 2 |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + W$(i), 10); " ("; Trm$(WX(i)); ", "; Trm$(WY(i)); ") >>>---> "; Trm$(WD(i)); |
|||
IF i + 1 <= WI THEN |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + W$(i + 1), 10); " ("; Trm$(WX(i + 1)); ", "; Trm$(WY(i + 1)); ") >>>---> "; Trm$(WD(i + 1)) |
|||
ELSE |
|||
PRINT #1, "" |
|||
END IF |
|||
NEXT |
|||
PRINT #1, "" |
|||
PRINT #1, " These are the items from unixdict.txt found embedded in the puzzle:" |
|||
PRINT #1, "" |
|||
FOR i = 1 TO ALLindex STEP 2 |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i), 10); " ("; Trm$(AllX(i)); ", "; Trm$(AllY(i)); ") >>>---> "; Trm$(AllD(i)); |
|||
IF i + 1 <= ALLindex THEN |
|||
PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i + 1), 10); " ("; Trm$(AllX(i + 1)); ", "; Trm$(AllY(i + 1)); ") >>>---> "; Trm$(AllD(i + 1)) |
|||
ELSE |
|||
PRINT #1, "" |
|||
END IF |
|||
NEXT |
|||
CLOSE #1 |
|||
END SUB</syntaxhighlight> |
|||
---- |
|||
'''Sample Output:''' |
|||
<br><br><code> |
|||
0 1 2 3 4 5 6 7 8 9 <br> |
|||
0 t g a m m R l b a r <br> |
|||
1 o e O k y u i l u b <br> |
|||
2 l S e e n n i o a t <br> |
|||
3 s a g d E u i d e w <br> |
|||
4 k T c t e h g s a T <br> |
|||
5 s e n o j b o A e r <br> |
|||
6 C l g n c o a p g r <br> |
|||
7 l i o d i u m u e O <br> |
|||
8 k a e r f D d y c t <br> |
|||
9 t j E a i d r a p h <br></code> |
|||
<br>Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE<br> |
|||
<br> |
|||
These are the items from unixdict.txt used to build the puzzle: |
|||
1) odium (2, 7) >>>---> 0 2) resiny (9, 6) >>>---> 5 |
|||
3) debauch (3, 3) >>>---> 1 4) freak (4, 8) >>>---> 4 |
|||
5) jones (4, 5) >>>---> 4 6) radium (9, 5) >>>---> 5 |
|||
7) hope (5, 4) >>>---> 1 8) coca (4, 6) >>>---> 5 |
|||
9) slot (0, 3) >>>---> 6 10) aid (3, 9) >>>---> 0 |
|||
11) gunk (6, 4) >>>---> 5 12) keg (0, 4) >>>---> 1 |
|||
13) aile (1, 8) >>>---> 6 14) set (7, 4) >>>---> 7 |
|||
15) wall (9, 3) >>>---> 5 16) rye (6, 9) >>>---> 7 |
|||
17) our (7, 2) >>>---> 7 18) bar (7, 0) >>>---> 0 |
|||
19) par (8, 9) >>>---> 4 20) gam (1, 0) >>>---> 0 |
|||
21) dee (3, 3) >>>---> 5 22) ton (3, 4) >>>---> 2 |
|||
23) dab (7, 3) >>>---> 7 24) jed (1, 9) >>>---> 7 |
|||
25) bin (7, 0) >>>---> 3 26) pet (7, 6) >>>---> 1 |
|||
27) sag (0, 3) >>>---> 0 28) nco (3, 6) >>>---> 0 |
|||
29) dug (6, 8) >>>---> 7 30) oat (2, 7) >>>---> 3 |
|||
31) oil (2, 7) >>>---> 4 32) nee (4, 2) >>>---> 4 |
|||
These are the items from unixdict.txt found embedded in the puzzle:<br> |
|||
1) abe (6, 6) >>>---> 5 2) abed (6, 6) >>>---> 5 |
|||
3) aid (3, 9) >>>---> 0 4) ail (1, 8) >>>---> 6 |
|||
5) aile (1, 8) >>>---> 6 6) ali (8, 0) >>>---> 3 |
|||
7) all (8, 2) >>>---> 5 8) bad (9, 1) >>>---> 3 |
|||
9) bar (7, 0) >>>---> 0 10) bed (5, 5) >>>---> 5 |
|||
11) bin (7, 0) >>>---> 3 12) but (7, 0) >>>---> 1 |
|||
13) cal (2, 4) >>>---> 5 14) coca (4, 6) >>>---> 5 |
|||
15) cud (4, 6) >>>---> 1 16) dab (7, 3) >>>---> 7 |
|||
17) dar (7, 3) >>>---> 1 18) debauch (3, 3) >>>---> 1 |
|||
19) dee (3, 3) >>>---> 5 20) dew (7, 3) >>>---> 0 |
|||
21) dug (6, 8) >>>---> 7 22) edt (3, 2) >>>---> 2 |
|||
23) eli (1, 5) >>>---> 2 24) etc (4, 4) >>>---> 4 |
|||
25) freak (4, 8) >>>---> 4 26) gam (1, 0) >>>---> 0 |
|||
27) gas (2, 3) >>>---> 4 28) goa (6, 4) >>>---> 2 |
|||
29) gsa (6, 4) >>>---> 0 30) gun (6, 4) >>>---> 5 |
|||
31) gunk (6, 4) >>>---> 5 32) hop (5, 4) >>>---> 1 |
|||
33) hope (5, 4) >>>---> 1 34) hun (5, 4) >>>---> 6 |
|||
35) ida (6, 2) >>>---> 1 36) iii (6, 1) >>>---> 2 |
|||
37) iii (6, 3) >>>---> 6 38) inn (6, 2) >>>---> 4 |
|||
39) inn (4, 7) >>>---> 5 40) jail (1, 9) >>>---> 6 |
|||
41) jed (1, 9) >>>---> 7 42) jon (4, 5) >>>---> 4 |
|||
43) jones (4, 5) >>>---> 4 44) keg (0, 4) >>>---> 1 |
|||
45) lac (0, 2) >>>---> 1 46) law (7, 1) >>>---> 1 |
|||
47) lea (0, 2) >>>---> 7 48) lot (0, 2) >>>---> 6 |
|||
49) lund (6, 0) >>>---> 3 50) mao (6, 7) >>>---> 6 |
|||
51) nco (3, 6) >>>---> 0 52) nee (4, 2) >>>---> 4 |
|||
53) nib (5, 2) >>>---> 7 54) nne (5, 2) >>>---> 4 |
|||
55) not (3, 6) >>>---> 6 56) oat (7, 2) >>>---> 0 |
|||
57) oat (2, 7) >>>---> 3 58) odium (2, 7) >>>---> 0 |
|||
59) oil (2, 7) >>>---> 4 60) one (3, 5) >>>---> 4 |
|||
61) our (7, 2) >>>---> 7 62) par (8, 9) >>>---> 4 |
|||
63) pet (7, 6) >>>---> 1 64) radium (9, 5) >>>---> 5 |
|||
65) rap (6, 9) >>>---> 0 66) resin (9, 6) >>>---> 5 |
|||
67) resiny (9, 6) >>>---> 5 68) rio (3, 8) >>>---> 7 |
|||
69) rye (6, 9) >>>---> 7 70) sag (0, 3) >>>---> 0 |
|||
71) sen (0, 5) >>>---> 0 72) set (7, 4) >>>---> 7 |
|||
73) sin (7, 4) >>>---> 5 74) slot (0, 3) >>>---> 6 |
|||
75) tao (9, 2) >>>---> 4 76) tao (0, 9) >>>---> 7 |
|||
77) tee (0, 0) >>>---> 1 78) ton (3, 4) >>>---> 2 |
|||
79) tub (9, 2) >>>---> 5 80) wall (9, 3) >>>---> 5 |
|||
81) wed (9, 3) >>>---> 4 |
|||
<br> |
|||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
Line 3,691: | Line 3,948: | ||
wei H 0 ↘ </pre> |
wei H 0 ↘ </pre> |
||
=={{header|Visual Basic .NET}}== |
|||
{{trans|C#}} |
|||
<syntaxhighlight lang="vbnet">Module Module1 |
|||
ReadOnly Dirs As Integer(,) = { |
|||
{1, 0}, {0, 1}, {1, 1}, |
|||
{1, -1}, {-1, 0}, |
|||
{0, -1}, {-1, -1}, {-1, 1} |
|||
} |
|||
Const RowCount = 10 |
|||
Const ColCount = 10 |
|||
Const GridSize = RowCount * ColCount |
|||
Const MinWords = 25 |
|||
Class Grid |
|||
Public cells(RowCount - 1, ColCount - 1) As Char |
|||
Public solutions As New List(Of String) |
|||
Public numAttempts As Integer |
|||
Sub New() |
|||
For i = 0 To RowCount - 1 |
|||
For j = 0 To ColCount - 1 |
|||
cells(i, j) = ControlChars.NullChar |
|||
Next |
|||
Next |
|||
End Sub |
|||
End Class |
|||
Dim Rand As New Random() |
|||
Sub Main() |
|||
PrintResult(CreateWordSearch(ReadWords("unixdict.txt"))) |
|||
End Sub |
|||
Function ReadWords(filename As String) As List(Of String) |
|||
Dim maxlen = Math.Max(RowCount, ColCount) |
|||
Dim words As New List(Of String) |
|||
Dim objReader As New IO.StreamReader(filename) |
|||
Dim line As String |
|||
Do While objReader.Peek() <> -1 |
|||
line = objReader.ReadLine() |
|||
If line.Length > 3 And line.Length < maxlen Then |
|||
If line.All(Function(c) Char.IsLetter(c)) Then |
|||
words.Add(line) |
|||
End If |
|||
End If |
|||
Loop |
|||
Return words |
|||
End Function |
|||
Function CreateWordSearch(words As List(Of String)) As Grid |
|||
For numAttempts = 1 To 1000 |
|||
Shuffle(words) |
|||
Dim grid As New Grid() |
|||
Dim messageLen = PlaceMessage(grid, "Rosetta Code") |
|||
Dim target = GridSize - messageLen |
|||
Dim cellsFilled = 0 |
|||
For Each word In words |
|||
cellsFilled = cellsFilled + TryPlaceWord(grid, word) |
|||
If cellsFilled = target Then |
|||
If grid.solutions.Count >= MinWords Then |
|||
grid.numAttempts = numAttempts |
|||
Return grid |
|||
Else |
|||
'grid is full but we didn't pack enough words, start over |
|||
Exit For |
|||
End If |
|||
End If |
|||
Next |
|||
Next |
|||
Return Nothing |
|||
End Function |
|||
Function PlaceMessage(grid As Grid, msg As String) As Integer |
|||
msg = msg.ToUpper() |
|||
msg = msg.Replace(" ", "") |
|||
If msg.Length > 0 And msg.Length < GridSize Then |
|||
Dim gapSize As Integer = GridSize / msg.Length |
|||
Dim pos = 0 |
|||
Dim lastPos = -1 |
|||
For i = 0 To msg.Length - 1 |
|||
If i = 0 Then |
|||
pos = pos + Rand.Next(gapSize - 1) |
|||
Else |
|||
pos = pos + Rand.Next(2, gapSize - 1) |
|||
End If |
|||
Dim r As Integer = Math.Floor(pos / ColCount) |
|||
Dim c = pos Mod ColCount |
|||
grid.cells(r, c) = msg(i) |
|||
lastPos = pos |
|||
Next |
|||
Return msg.Length |
|||
End If |
|||
Return 0 |
|||
End Function |
|||
Function TryPlaceWord(grid As Grid, word As String) As Integer |
|||
Dim randDir = Rand.Next(Dirs.GetLength(0)) |
|||
Dim randPos = Rand.Next(GridSize) |
|||
For d = 0 To Dirs.GetLength(0) - 1 |
|||
Dim dd = (d + randDir) Mod Dirs.GetLength(0) |
|||
For p = 0 To GridSize - 1 |
|||
Dim pp = (p + randPos) Mod GridSize |
|||
Dim lettersPLaced = TryLocation(grid, word, dd, pp) |
|||
If lettersPLaced > 0 Then |
|||
Return lettersPLaced |
|||
End If |
|||
Next |
|||
Next |
|||
Return 0 |
|||
End Function |
|||
Function TryLocation(grid As Grid, word As String, dir As Integer, pos As Integer) As Integer |
|||
Dim r As Integer = pos / ColCount |
|||
Dim c = pos Mod ColCount |
|||
Dim len = word.Length |
|||
'check bounds |
|||
If (Dirs(dir, 0) = 1 And len + c >= ColCount) Or (Dirs(dir, 0) = -1 And len - 1 > c) Or (Dirs(dir, 1) = 1 And len + r >= RowCount) Or (Dirs(dir, 1) = -1 And len - 1 > r) Then |
|||
Return 0 |
|||
End If |
|||
If r = RowCount OrElse c = ColCount Then |
|||
Return 0 |
|||
End If |
|||
Dim rr = r |
|||
Dim cc = c |
|||
'check cells |
|||
For i = 0 To len - 1 |
|||
If grid.cells(rr, cc) <> ControlChars.NullChar AndAlso grid.cells(rr, cc) <> word(i) Then |
|||
Return 0 |
|||
End If |
|||
cc = cc + Dirs(dir, 0) |
|||
rr = rr + Dirs(dir, 1) |
|||
Next |
|||
'place |
|||
Dim overlaps = 0 |
|||
rr = r |
|||
cc = c |
|||
For i = 0 To len - 1 |
|||
If grid.cells(rr, cc) = word(i) Then |
|||
overlaps = overlaps + 1 |
|||
Else |
|||
grid.cells(rr, cc) = word(i) |
|||
End If |
|||
If i < len - 1 Then |
|||
cc = cc + Dirs(dir, 0) |
|||
rr = rr + Dirs(dir, 1) |
|||
End If |
|||
Next |
|||
Dim lettersPlaced = len - overlaps |
|||
If lettersPlaced > 0 Then |
|||
grid.solutions.Add(String.Format("{0,-10} ({1},{2})({3},{4})", word, c, r, cc, rr)) |
|||
End If |
|||
Return lettersPlaced |
|||
End Function |
|||
Sub PrintResult(grid As Grid) |
|||
If IsNothing(grid) OrElse grid.numAttempts = 0 Then |
|||
Console.WriteLine("No grid to display") |
|||
Return |
|||
End If |
|||
Console.WriteLine("Attempts: {0}", grid.numAttempts) |
|||
Console.WriteLine("Number of words: {0}", GridSize) |
|||
Console.WriteLine() |
|||
Console.WriteLine(" 0 1 2 3 4 5 6 7 8 9") |
|||
For r = 0 To RowCount - 1 |
|||
Console.WriteLine() |
|||
Console.Write("{0} ", r) |
|||
For c = 0 To ColCount - 1 |
|||
Console.Write(" {0} ", grid.cells(r, c)) |
|||
Next |
|||
Next |
|||
Console.WriteLine() |
|||
Console.WriteLine() |
|||
For i = 0 To grid.solutions.Count - 1 |
|||
If i Mod 2 = 0 Then |
|||
Console.Write("{0}", grid.solutions(i)) |
|||
Else |
|||
Console.WriteLine(" {0}", grid.solutions(i)) |
|||
End If |
|||
Next |
|||
Console.WriteLine() |
|||
End Sub |
|||
'taken from https://stackoverflow.com/a/20449161 |
|||
Sub Shuffle(Of T)(list As IList(Of T)) |
|||
Dim r As Random = New Random() |
|||
For i = 0 To list.Count - 1 |
|||
Dim index As Integer = r.Next(i, list.Count) |
|||
If i <> index Then |
|||
' swap list(i) and list(index) |
|||
Dim temp As T = list(i) |
|||
list(i) = list(index) |
|||
list(index) = temp |
|||
End If |
|||
Next |
|||
End Sub |
|||
End Module</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Attempts: 148 |
|||
Number of words: 100 |
|||
0 1 2 3 4 5 6 7 8 9 |
|||
0 c d p R e c h a r e |
|||
1 O i u b a k e S l v |
|||
2 k n l E m c a c a i |
|||
3 T e s i T x A s n t |
|||
4 t C e s a l O a g a |
|||
5 a j D l l e E h l g |
|||
6 l u f e m a h s e r |
|||
7 l t c a r f e r y u |
|||
8 f e r r e i r a m p |
|||
9 f a m i l i s m i s |
|||
refract (7,7)(1,7) shameful (7,6)(0,6) |
|||
ferreira (0,8)(7,8) familism (0,9)(7,9) |
|||
langley (8,1)(8,7) sake (7,3)(4,0) |
|||
pulse (2,0)(2,4) purgative (9,8)(9,0) |
|||
cacm (7,2)(4,2) enid (1,3)(1,0) |
|||
char (5,0)(8,0) flax (2,6)(5,3) |
|||
tall (0,4)(0,7) isle (3,3)(3,6) |
|||
jute (1,5)(1,8) myel (8,8)(8,5) |
|||
bake (3,1)(6,1) cell (2,7)(5,4) |
|||
marsh (7,9)(7,5) keel (0,2)(3,5) |
|||
spur (9,9)(9,6) leaf (5,4)(5,7) |
|||
cilia (0,0)(4,4) sims (9,9)(6,9) |
|||
marsha (7,9)(7,4)</pre> |
|||
=={{header|Wren}}== |
=={{header|Wren}}== |