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

Home > General > Word Problems
All the Vowels (Posted on 2018-02-20) Difficulty: 3 of 5
What sets of five 4-letter words differ by one letter position in which each of the words has a different one of the five vowels (not counting Y) in that position?

  Submitted by Charlie    
No Rating
Solution: (Hide)

bads  beds  bids  bods  buds
bags  begs  bigs  bogs  bugs
ball  bell  bill  boll  bull
band  bend  bind  bond  bund
bats  bets  bits  bots  buts
care  cere  cire  core  cure
cate  cete  cite  cote  cute
dare  dere  dire  dore  dure
fans  fens  fins  fons  funs
hack  heck  hick  hock  huck
haed  heed  hied  hoed  hued
hats  hets  hits  hots  huts
last  lest  list  lost  lust
mags  megs  migs  mogs  mugs
mall  mell  mill  moll  mull
mare  mere  mire  more  mure
mass  mess  miss  moss  muss
mate  mete  mite  mote  mute
nabs  nebs  nibs  nobs  nubs
pack  peck  pick  pock  puck
pale  pele  pile  pole  pule
pans  pens  pins  pons  puns
paps  peps  pips  pops  pups
pats  pets  pits  pots  puts
rack  reck  rick  rock  ruck
rams  rems  rims  roms  rums
tale  tele  tile  tole  tule
tans  tens  tins  tons  tuns
tats  tets  tits  tots  tuts


A more extensive list can be found in Dej Mar's post.

DefDbl A-Z
Dim crlf$


Private Sub Form_Load()
 Form1.Visible = True
 Text1.Text = ""
 crlf = Chr(13) + Chr(10)
 
 
 Open "c:\\words\\words4.txt" For Binary As #1
 w0$ = "    "
 Do
   Get #1, , w0$
   If EOF(1) Then Exit Do
   
   If InStr(w0$, "a") > 0 Then
     For apos = 1 To 4
       If Mid(w0$, apos, 1) = "a" Then
         good = 1
         For i = 1 To 4
           w$ = w0$
           Mid(w, apos, 1) = Mid("eiou", i, 1)
           If isWord(w) = 0 Then good = 0: Exit For
         Next
         If good Then
           Text1.Text = Text1.Text & w0
           For i = 1 To 4
             w$ = w0$
             Mid(w, apos, 1) = Mid("eiou", i, 1)
             Text1.Text = Text1.Text & "  " & w
           Next
           Text1.Text = Text1.Text & crlf
         End If
       End If
     Next
   End If
   DoEvents
 Loop
 Close 1
 
 Text1.Text = Text1.Text & crlf & " done"
  
End Sub

Function isWord(w$)
 n = Len(w$)
 w1$ = Space$(n)
 Open "c:\\words\\words" + LTrim$(Str$(n)) + ".txt" For Binary As #2
 l = LOF(2) / n
 low = 1: high = l
 Do
  DoEvents
  middle = Int((low + high) / 2)
  Get #2, (middle - 1) * n + 1, w1$
  If w1$ = w$ Then isWord = 1: Close 2: Exit Function
  If w1$ < w$ Then low = middle + 1 Else high = middle - 1
 Loop Until low > high
 isWord = 0
 Close 2
End Function

Comments: ( You must be logged in to post comments.)
  Subject Author Date
SolutionanswerDej Mar2018-02-20 10:02:03
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 (12)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

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