Rosetta Code

Word search: Difference between revisions

Page Discussion

Word search (view source)

Revision as of 16:34, 5 July 2021

6,007 bytes added ,  2 years ago
m
→‎{{header|FreeBASIC}}: made it work properly
(Word search en FreeBASIC)
m (→‎{{header|FreeBASIC}}: made it work properly)
Line 915:
=={{header|FreeBASIC}}==
{{trans|QB64}}
Changes:
<lang freebasic>
ShowPuzzle gets call only after a word is inserted in the grid.
Randomize Timer ' OK getting a good puzzle every time
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.
<lang freebasic>Randomize Timer ' OK getting a good puzzle every time
 
#Macro TrmSS (n)
LTrim(Str(n))
#EndMacro
 
'overhauled
Dim Shared As ByteULong LengthLimit(3 To 10) 'reset in Initialize, track and limit longer words
 
'LoadWords opens file of words and sets
Dim Shared As IntegerULong 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 IntegerULong 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 ByteULong 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 ByteLong DX(0 To 7), DY(0 To 7)
DX(0) = 1: DY(0) = 0
DX(1) = 1: DY(1) = 1
Line 946 ⟶ 956:
'to store all the words found embedded in the grid LSS()
Dim Shared As String ALLSS(1 To 200)
Dim Shared As ByteULong 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 IntegerULong ALLindex
 
' signal successful fill of puzzle
Dim Shared FILLED As Boolean
Dim Shared As ULong try = 1
FILLED = 0
Dim As Byte try
try = 1
 
 
Sub LoadWords
Dim As String wdSS
Dim As IntegerULong i, m, ff = FreeFile
Dim ok As Boolean
 
Open "unixdict.txt" For Input As #1
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 #1ff, wdSS
If Len(wdSS) > 2 And Len(wdSS) < 11 Then
ok = -1TRUE
For m = 1 To Len(wdSS)
If Asc(wdSS, m) < 97 Or Asc(wdSS, m) > 122 Then ok = 0FALSE: Exit For
Next
If ok Then i += 1: WORDSSS(i) = wdSS: CWORDSSS(i) = wdSS
End If
Wend
Close #1ff
NWORDS = i
End Sub
 
Sub Shuffle
Dim As IntegerULong i, r
For i = NWORDS To 2 Step -1
r = Int(Rnd * i) + 1
Swap WORDSSS(i), WORDSSS(r)
Next i
End Sub
 
Sub Initialize
Dim As ByteULong 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 c
Next r
 
'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"
Line 1,005 ⟶ 1,020:
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
Line 1,015 ⟶ 1,030:
LengthLimit(9) = 0
LengthLimit(10) = 0
 
'reset word order
Shuffle
Line 1,021 ⟶ 1,036:
 
'for fun plug-in of words
Sub pluggin (wdSS As String, x As IntegerLong, y As IntegerLong, d As IntegerLong)
 
For i As Byte = 0 To Len(wdSS) - 1
For i As ULong = 0 To Len(wdSS) - 1
LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1)
Next i
WI += WI
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d
End Sub
 
' Function TrmSS (n As Integer) As String
' TrmSS = RtrimRTrim(LtrimLTrim(Str(n)))
' End Function
 
'used in PlaceWord
Function CountSpaces () As IntegerULong
Dim As ByteULong x, y, count
 
Dim count As Integer
For y = 0 To 9
For x = 0 To 9
If LSS(x, y) = " " Then count += 1
Next x
Next y
CountSpaces = count
End Function
 
Sub ShowPuzzle
Dim As ByteULong i, x, y
'Dim As String wateSS
 
Cls
Print " 0 1 2 3 4 5 6 7 8 9"
Line 1,053 ⟶ 1,070:
For i = 0 To 9
Print TrmSS(i)
Next i
For y = 0 To 9
For x = 0 To 9
Locate y + 3, 2 * x + 5: Print LSS(x, y)
Next x
Next y
For i = 1 To WI
If i < 2021 Then
Locate i + 1, 30: Print TrmSS(i); " "; WSS(i)
ElseifElseIf i < 4041 Then
Locate i - 20 + 1, 45: Print TrmSS(i); " "; WSS(i)
ElseifElseIf i < 6061 Then
Locate i - 40 + 1, 60: Print TrmSS(i); " "; WSS(i)
End If
Next i
Locate 18, 1: Print "Spaces left:"; CountSpaces
Locate 19, 1: Print NWORDS
Line 1,076 ⟶ 1,093:
 
'used in PlaceWord
Function Match (word As String, template As String) As IntegerLong
Dim i As IntegerULong
Dim c As String
Match = 0
Line 1,095 ⟶ 1,112:
' 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, wateSS
Dim As Byte wLen, spot, testNum,Long rdir
Dim As ByteULong xwLen, yspot, d, dNum, rdd, i, jtestNum
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 = Int(spot /\ 10)
x = spot Mod 10
If LSS(x, y) = Mid(wdSS, 1, 1) Or LSS(x, y) = " " Then
Line 1,132 ⟶ 1,151:
WI += 1
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d
If CountSpaces = 0 Then FILLED = -1ShowPuzzle
If CountSpaces = 0 Then FILLED = TRUE
Exit Sub 'get out now that word is loaded
End If
Line 1,150 ⟶ 1,170:
Sub FindAllWords
Dim As String wdSS, templateSS, wateSS
Dim As ByteULong wLen, x, y, d, j
Dim As Boolean b1, b2
 
For i As IntegerULong = 1 To NWORDS
wdSS = CWORDSSS(i)
wLen = Len(wdSS) - 1
Line 1,166 ⟶ 1,186:
For j = 0 To wLen
templateSS += LSS(x + j * DX(d), y + j * DY(d))
Next j
If templateSS = wdSS Then 'foundafound a word
'store it
ALLindex += 1
Line 1,177 ⟶ 1,197:
End If
End If
Next d
End If
Next x
Next y
Next i
End Sub
 
Sub FilePuzzle
Dim As ByteULong i, r, c, ff = FreeFile
Dim As String bSS
 
Open "WS Puzzle.txt" For Output As #1
Open "WS Puzzle.txt" For Output As #ff
Print " 0 1 2 3 4 5 6 7 8 9"
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 c
Print #ff, bSS
Next r
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 i
ClosePrint #1ff,
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
Line 1,231 ⟶ 1,255:
For WORDSINDEX = 1 To NWORDS
PlaceWord
' ShowPuzzle
If FILLED Then Exit For
Next WORDSINDEX
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
Line 1,243 ⟶ 1,276:
End If
Wend
 
If FILLED = 0 Then Locate 23, 1: Print "Sorry, 10 tries and no success."
If Not FILLED Then Locate 23, 1: Print "Sorry, 10 tries and no success."
End
 
</lang>
Sleep
End</lang>
{{out}}
<pre style="height:52ex;overflow:scroll"> 0 1 2 3 4 5 6 7 8 9
<pre>
 
Igual que la entrada de QB64.
0 m g y m l a i r R u
</pre>
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}}==
Frisian
457

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/266515"