All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars
 perplexus dot info

 Minimum Scrabble (Posted on 2009-09-02)

 No Solution Yet Submitted by brianjn No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
 preliminary computer result | Comment 1 of 8

Dim bd(3, 4)
Dim cons, vowels, usedC(20), usedV(6), usedInWord(3, 4), wordList
Dim noWds4, wordCt, solCt, theWord, continue

Private Sub Command1_Click()
continue = 1
End Sub

Me.Visible = True
wordList = ""
cons = "bcdfghjklmnpqrstvwxz": vowels = "aeiouy"
Print Len(cons) + Len(vowels)
Open "\words\words4.txt" For Binary As #1
noWds4 = LOF(1) / 4
place 1, 1
Print "done"
End Sub
Function isWord(w)
wd\$ = String\$(4, " ")
low = 1: high = noWds4
Do
m = Int((low + high) / 2)
Get #1, (m - 1) * 4 + 1, wd\$
If w = wd\$ Then Exit Do
If wd\$ < w Then low = m + 1 Else high = m - 1
Loop Until low > high
If w = wd\$ Then isWord = True: theWord = w Else isWord = False
End Function
Sub place(row, col)
DoEvents
If row = 1 Then
bgn = 1
If col = 1 Or col = 3 Then fin = Len(cons) Else fin = Len(vowels)
Else
Select Case col
Case 1, 3
bgn = InStr(cons, bd(row - 1, col)) + 1
fin = Len(cons)
Case Else
bgn = InStr(vowels, bd(row - 1, col)) + 1
fin = Len(vowels)
End Select
End If
For i = bgn To fin
good = 1
If fin = Len(vowels) Then
If usedV(i) = 0 Then ltr = Mid(vowels, i, 1): usedV(i) = -1 Else good = 0
Else
If usedC(i) = 0 Then ltr = Mid(cons, i, 1): usedC(i) = -1 Else good = 0
End If
If good Then
bd(row, col) = ltr
wSave = wordList

If row = 1 Then
If col = 4 Then
If isWord(bd(1, 1) + bd(1, 2) + bd(1, 3) + bd(1, 4)) Then wordAdd = 1
End If
Else
Select Case col
Case 1: b1 = row: e1 = row: b2 = 1: e2 = row - 1: b3 = 1: e3 = row - 1: b4 = 1: e4 = row - 1
Case 2: b1 = 1: e1 = row: b2 = row: e2 = row: b3 = 1: e3 = row - 1: b4 = 1: e4 = row - 1
Case 3: b1 = 1: e1 = row: b2 = 1: e2 = row: b3 = row: e3 = row: b4 = 1: e4 = row - 1
Case 4: b1 = 1: e1 = row: b2 = 1: e2 = row: b3 = 1: e3 = row: b4 = row: e4 = row
End Select
For i1 = b1 To e1
For i2 = b2 To e2
For i3 = b3 To e3
For i4 = b4 To e4
If isWord(bd(i1, 1) + bd(i2, 2) + bd(i3, 3) + bd(i4, 4)) Then
usedInWord(i1, 1) = usedInWord(i1, 1) + 1
usedInWord(i2, 2) = usedInWord(i2, 2) + 1
usedInWord(i3, 3) = usedInWord(i3, 3) + 1
usedInWord(i4, 4) = usedInWord(i4, 4) + 1
wordList = wordList + bd(i1, 1) + bd(i2, 2) + bd(i3, 3) + bd(i4, 4) + Chr(13) + Chr(10)
End If
Next
Next
Next
Next
End If  ' row 1 vs not 1

If wordCt <= 3 * row Then
c = col + 1: r = row
If c > 4 Then c = 1: r = r + 1
If r > 3 Then
If wordCt < 9 Then
CurrentX = 1: CurrentY = 1
Text1.Text = ""
For r = 1 To 3
For c = 1 To 4
If usedInWord(r, c) = 0 Then good = 0: Exit For
Next
If good = 0 Then Exit For
Next
If good Then
solCt = solCt + 1
For r = 1 To 3
For c = 1 To 4
Print bd(r, c);
Text1.Text = Text1.Text + bd(r, c)
Next: Print "    ": Text1.Text = Text1.Text + Chr(13) + Chr(10)
Next: Print solCt; "   "
Text1.Text = Text1.Text + Chr(13) + Chr(10) + wordList + Chr(13) + Chr(10) + Str(wordCt)
Print theWord; "      "
continue = 0
Do
DoEvents
Loop Until continue = 1
End If
End If
DoEvents
Else
place r, c
End If
End If

For i1 = b1 To e1
For i2 = b2 To e2
For i3 = b3 To e3
For i4 = b4 To e4
If isWord(bd(i1, 1) + bd(i2, 2) + bd(i3, 3) + bd(i4, 4)) Then
usedInWord(i1, 1) = usedInWord(i1, 1) - 1
usedInWord(i2, 2) = usedInWord(i2, 2) - 1
usedInWord(i3, 3) = usedInWord(i3, 3) - 1
usedInWord(i4, 4) = usedInWord(i4, 4) - 1
End If
Next
Next
Next
Next

wordList = wSave
If fin = Len(vowels) Then
usedV(i) = 0
Else
usedC(i) = 0
End If
End If
Next
End Sub

shows as the 35th potential solution (I've discarded results relying on obscure words):

bace
fogi
hupy

face
foci
fuci
huge
hope
bogy
fogy

7

It shows 7 formable words, but fuci is obscure, and it's not needed for any of the letters placed in the mauve area, bringing the word count down to 6. In fact we can remove fogy as being obscure bringing the total down to 5, but then we make problematic why we leave bogy, needed for the b.

 Posted by Charlie on 2009-09-02 14:14:20

 Search: Search body:
Forums (0)