The Task:
Scan from left to right a long word of your choice and extract letters , composing valid
English words.
The following constraints apply:
i. The initial word contains no more than 15 letters.
ii. The selected words will be 3 letters or more.
iii. No proper names, no abbreviations.
iv. Slang words and words of foreign origin
(like verbatim or sans) are allowed as long as they appear in at least one respectable dictionary.
v. Words created by adding "s" to a word already in a list are not allowed.
vi. The original long word of your choice is also discounted.
Example: if your word were procrastination the list could contain, inter alia:
position, post, ion, rotation and many others.
The Challenge:
Create the longest list.
Team work (i.e. adding your words to another solver's list)
allowed and encouraged.
(In reply to
some computer results by Charlie)
DefDbl A-Z
Dim crlf$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
Open "words large to small.txt" For Input As #1
Open "words from word.txt" For Output As #2
Do
Line Input #1, l$
l = RTrim(Left(l, 16))
If Len(l) < 13 Then Exit Do
ct = 0: lst$ = ","
Open "\words\words.txt" For Input As #10
Do
Line Input #10, w$
If Len(w) < Len(l) And Len(w) >= 3 Then
good = 1: ix = 0
If Right(w, 1) = "s" Then
If InStr(lst, "," + Left(w, Len(w) - 1) + ",") > 0 Then
good = 0
End If
End If
If good Then
For i = 1 To Len(w)
ix = InStr(ix + 1, l, Mid(w, i, 1))
If ix = 0 Then good = 0: Exit For
Next
If good Then
ct = ct + 1
lst = lst + w + ","
End If
End If
End If
DoEvents
Loop Until EOF(10)
If ct >= 200 Then
l = Left(l + " ", 16)
Print #2, l; mform(ct, "###0")
If ct >= 200 Then Print #2, Mid(lst, 2, Len(lst) - 2): Print #2,
Text1.Text = Text1.Text & l & mform(ct, "###0") & crlf
If ct >= 200 Then Text1.Text = Text1.Text & Mid(lst, 2, Len(lst) - 2) & crlf & crlf
' mx = ct
End If
Close 10
DoEvents
Loop Until EOF(1)
Close 1: Close 2
Text1.Text = Text1.Text & crlf & " done"
End Sub
|
|
Posted by Charlie
on 2017-02-10 23:31:27 |
re: some computer results -- the program
