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

Home > General > Word Problems
Most words from your word (Posted on 2017-02-10) Difficulty: 4 of 5
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.

No Solution Yet Submitted by Ady TZIDON    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
re: some computer results -- the program | Comment 2 of 10 |
(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
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (2)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information