Word wheel
You are encouraged to solve this task according to the task description, using any language you may know.
A "word wheel" is a type of word game commonly found on the "puzzle" page of newspapers. You are presented with nine letters arranged in a circle or 3×3 grid. The objective is to find as many words as you can using only the letters contained in the wheel or grid. Each word must contain the letter in the centre of the wheel or grid. Usually there will be a minimum word length of 3 or 4 characters. Each letter may only be used as many times as it appears in the wheel or grid.
- An example
N D E O K G E L W
- Task
Write a program to solve the above "word wheel" puzzle.
Specifically:
- Find all words of 3 or more letters using only the letters in the string ndeokgelw.
- All words must contain the central letter k.
- Each letter may be used only as many times as it appears in the string.
- For this task we'll use lowercase English letters exclusively.
A "word" is defined to be any string contained in the file located at http://wiki.puzzlers.org/pub/wordlists/unixdict.txt.
If you prefer to use a different dictionary, please state which one you have used.
- Optional extra
Word wheel puzzles usually state that there is at least one nine-letter word to be found. Using the above dictionary, find the 3x3 grids with at least one nine-letter solution that generate the largest number of words of three or more letters.
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contains most consonants
- Find words which contains more than 3 vowels
- Find words which first and last three letters are equals
- Find words which odd letters are consonants and even letters are vowels or vice_versa
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 Bottles of Beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
<lang 11l>V GRID = ‘N D E
O K G E L W’
F getwords()
V words = File(‘unixdict.txt’).read().lowercase().split("\n") R words.filter(w -> w.len C 3..9)
F solve(grid, dictionary)
DefaultDict[Char, Int] gridcount L(g) grid gridcount[g]++
F check_word(word) DefaultDict[Char, Int] lcount L(l) word lcount[l]++ L(l, c) lcount I c > @gridcount[l] R 1B R 0B
V mid = grid[4] R dictionary.filter(word -> @mid C word & !@check_word(word))
V chars = GRID.lowercase().split_py().join(‘’) V found = solve(chars, dictionary' getwords()) print(found.join("\n"))</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
8080 Assembly
This program runs under CP/M, and takes the dictionary file and wheel definition
as arguments. The file is processed block by block, so it can be arbitrarily large
(the given ~206kb unixdict.txt
works fine).
<lang 8080asm>puts: equ 9 ; CP/M syscall to print string fopen: equ 15 ; CP/M syscall to open a file fread: equ 20 ; CP/M syscall to read from file FCB1: equ 5Ch ; First FCB (input file) DTA: equ 80h ; Disk transfer address org 100h ;;; Make wheel (2nd argument) lowercase and store it lxi d,DTA+1 ; Start of command line arguments scan: inr e ; Scan until we find a space rz ; Stop if not found in 128 bytes ldax d cpi ' ' ; Found it? jnz scan ; If not, try again inx d ; If so, wheel starts 1 byte onwards lxi h,wheel ; Space for wheel lxi b,920h ; B=9 (chars), C=20 (case bit) whlcpy: ldax d ; Get wheel character ora c ; Make lowercase mov m,a ; Store inx d ; Increment both pointers inx h dcr b ; Decrement counter jnz whlcpy ; While not zero, copy next character ;;; Open file in FCB1 mvi e,FCB1 ; D is already 0 mvi c,fopen call 5 ; Returns A=FF on error inr a ; If incrementing A gives zero, jz err ; then print error and stop lxi h,word ; Copy into word ;;; Read a 128-byte block from the file block: push h ; Keep word pointer lxi d,FCB1 ; Read from file mvi c,fread call 5 pop h ; Restore word pointer dcr a ; A=1 = EOF rz ; If so, stop. inr a ; Otherwise, A<>0 = error jnz err lxi d,DTA ; Start reading at DTA char: ldax d ; Get character mov m,a ; Store in word cpi 26 ; EOF reached? rz ; Then stop cpi 10 ; End of line reached? jz ckword ; Then we have a full word inx h ; Increment word pointer nxchar: inr e ; Increment DTA pointer (low byte) jz block ; If rollover, get next block jmp char ; Otherwise, handle next character in block ;;; Check if current word is valid ckword: push d ; Keep block pointer lxi d,wheel ; Copy the wheel lxi h,wcpy mvi c,9 ; 9 characters cpyw: ldax d ; Get character mov m,a ; Store in copy inx h ; Increment pointers inx d dcr c ; Decrement counters jnz cpyw ; Done yet? lxi d,word ; Read from current word wrdch: ldax d ; Get character cpi 32 ; Check if <32 jc wdone ; If so, the word is done lxi h,wcpy ; Check against the wheel letters mvi b,9 wlch: cmp m ; Did we find it? jz findch inx h ; If not, try next character in wheel dcr b ; As long as there are characters jnz wlch ; If no match, this word is invalid wnext: pop d ; Restore block pointer lxi h,word ; Start reading new word jmp nxchar ; Continue with character following word findch: mvi m,0 ; Found a match - set char to 0 inx d ; And look at next character in word jmp wrdch wdone: lda wcpy+4 ; Word is done - check if middle char used ana a ; If not, the word is invalid jnz wnext lxi h,wcpy ; See how many characters used lxi b,9 ; C=9 (counter), B=0 (used) whtest: mov a,m ; Get wheel character ana a ; Is it zero? jnz $+4 ; If not, skip next instr inr b ; If so, count it inx h ; Next wheel character dcr c ; Decrement counter jnz whtest mvi a,2 ; At least 3 characters must be used cmp b jnc wnext ; If not, the word is invalid xchg ; If so, the word _is_ valid, pointer in HL mvi m,13 ; add CR inx h mvi m,10 ; and LF inx h mvi m,'$' ; and the CP/M string terminator lxi d,word ; Then print the word mvi c,puts call 5 jmp wnext err: lxi d,errs ; Print file error mvi c,puts jz 5 errs: db 'File error$' ; Error message wheel: ds 9 ; Room for wheel wcpy: ds 9 ; Copy of wheel (to mark characters used) word: equ $ ; Room for current word</lang>
- Output:
A>wheel unixdict.txt ndeokgelw eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
APL
<lang APL>wordwheel←{
words←((~∊)∘⎕TC⊆⊢) 80 ¯1⎕MAP ⍵ match←{ 0=≢⍵:1 ~(⊃⍵)∊⍺:0 ⍺[(⍳⍴⍺)~⍺⍳⊃⍵]∇1↓⍵ } middle←(⌈0.5×≢)⊃⊢ words←((middle ⍺)∊¨words)/words words←(⍺∘match¨words)/words (⍺⍺≤≢¨words)/words
}</lang>
- Output:
'ndeokgelw' (3 wordwheel) 'unixdict.txt' eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
AppleScript
<lang applescript>use AppleScript version "2.4" use framework "Foundation" use scripting additions
WORD WHEEL ----------------------
-- wordWheelMatches :: NSString -> [String] -> String -> String on wordWheelMatches(lexicon, wordWheelRows)
set wheelGroups to group(sort(characters of ¬ concat(wordWheelRows))) script isWheelWord on |λ|(w) script available on |λ|(a, b) length of a ≤ length of b end |λ| end script script used on |λ|(grp) w contains item 1 of grp end |λ| end script all(my identity, ¬ zipWith(available, ¬ group(sort(characters of w)), ¬ filter(used, wheelGroups))) end |λ| end script set matches to filter(isWheelWord, ¬ filteredLines(wordWheelPreFilter(wordWheelRows), lexicon)) (length of matches as text) & " matches:" & ¬ linefeed & linefeed & unlines(matches)
end wordWheelMatches
-- wordWheelPreFilter :: [String] -> String
on wordWheelPreFilter(wordWheelRows)
set pivot to item 2 of item 2 of wordWheelRows set charSet to nub(concat(wordWheelRows)) "(2 < self.length) and (self contains '" & pivot & "') " & ¬ "and not (self matches '^.*[^" & charSet & "].*$') "
end wordWheelPreFilter
TEST -------------------------
on run
set fpWordList to scriptFolder() & "unixdict.txt" if doesFileExist(fpWordList) then wordWheelMatches(readFile(fpWordList), ¬ {"nde", "okg", "elw"}) else display dialog "Word list not found in script folder:" & ¬ linefeed & tab & fpWordList end if
end run
GENERIC :: FILTERED LINES FROM FILE ----------
-- doesFileExist :: FilePath -> IO Bool on doesFileExist(strPath)
set ca to current application set oPath to (ca's NSString's stringWithString:strPath)'s ¬ stringByStandardizingPath set {bln, int} to (ca's NSFileManager's defaultManager's ¬ fileExistsAtPath:oPath isDirectory:(reference)) bln and (int ≠ 1)
end doesFileExist
-- filteredLines :: String -> NString -> [a]
on filteredLines(predicateString, s)
-- A list of lines filtered by an NSPredicate string set ca to current application set predicate to ca's NSPredicate's predicateWithFormat:predicateString set array to ca's NSArray's ¬ arrayWithArray:(s's componentsSeparatedByString:(linefeed)) (array's filteredArrayUsingPredicate:(predicate)) as list
end filteredLines
-- readFile :: FilePath -> IO NSString
on readFile(strPath)
set ca to current application set e to reference set {s, e} to (ca's NSString's ¬ stringWithContentsOfFile:((ca's NSString's ¬ stringWithString:strPath)'s ¬ stringByStandardizingPath) ¬ encoding:(ca's NSUTF8StringEncoding) |error|:(e)) if missing value is e then s else (localizedDescription of e) as string end if
end readFile
-- scriptFolder :: () -> IO FilePath
on scriptFolder()
-- The path of the folder containing this script try tell application "Finder" to ¬ POSIX path of ((container of (path to me)) as alias) on error display dialog "Script file must be saved" end try
end scriptFolder
GENERIC ------------------------
-- Tuple (,) :: a -> b -> (a, b) on Tuple(a, b)
-- Constructor for a pair of values, -- possibly of two different types. {type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- all :: (a -> Bool) -> [a] -> Bool
on all(p, xs)
-- True if p holds for every value in xs tell mReturn(p) set lng to length of xs repeat with i from 1 to lng if not |λ|(item i of xs, i, xs) then return false end repeat true end tell
end all
-- concat :: a -> [a]
-- concat :: [String] -> String
on concat(xs)
set lng to length of xs if 0 < lng and string is class of (item 1 of xs) then set acc to "" else set acc to {} end if repeat with i from 1 to lng set acc to acc & item i of xs end repeat acc
end concat
-- eq (==) :: Eq a => a -> a -> Bool
on eq(a, b)
a = b
end eq
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(p, xs)
tell mReturn(p) set lst to {} set lng to length of xs repeat with i from 1 to lng set v to item i of xs if |λ|(v, i, xs) then set end of lst to v end repeat if {text, string} contains class of xs then lst as text else lst end if end tell
end filter
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f) set v to startValue set lng to length of xs repeat with i from 1 to lng set v to |λ|(v, item i of xs, i, xs) end repeat return v end tell
end foldl
-- group :: Eq a => [a] -> a
on group(xs)
script eq on |λ|(a, b) a = b end |λ| end script groupBy(eq, xs)
end group
-- groupBy :: (a -> a -> Bool) -> [a] -> a
on groupBy(f, xs)
-- Typical usage: groupBy(on(eq, f), xs) set mf to mReturn(f) script enGroup on |λ|(a, x) if length of (active of a) > 0 then set h to item 1 of active of a else set h to missing value end if if h is not missing value and mf's |λ|(h, x) then {active:(active of a) & {x}, sofar:sofar of a} else {active:{x}, sofar:(sofar of a) & {active of a}} end if end |λ| end script if length of xs > 0 then set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, rest of xs) if length of (active of dct) > 0 then sofar of dct & {active of dct} else sofar of dct end if else {} end if
end groupBy
-- identity :: a -> a
on identity(x)
-- The argument unchanged. x
end identity
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs if list is c or string is c then length of xs else (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite) end if
end |length|
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then y else x end if
end min
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function -- lifted into 1st class script wrapper. if script is class of f then f else script property |λ| : f end script end if
end mReturn
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f -- to each element of xs. tell mReturn(f) set lng to length of xs set lst to {} repeat with i from 1 to lng set end of lst to |λ|(item i of xs, i, xs) end repeat return lst end tell
end map
-- nub :: [a] -> [a]
on nub(xs)
nubBy(eq, xs)
end nub
-- nubBy :: (a -> a -> Bool) -> [a] -> [a]
on nubBy(f, xs)
set g to mReturn(f)'s |λ| script notEq property fEq : g on |λ|(a) script on |λ|(b) not fEq(a, b) end |λ| end script end |λ| end script script go on |λ|(xs) if (length of xs) > 1 then set x to item 1 of xs {x} & go's |λ|(filter(notEq's |λ|(x), items 2 thru -1 of xs)) else xs end if end |λ| end script go's |λ|(xs)
end nubBy
-- sort :: Ord a => [a] -> [a] on sort(xs)
((current application's NSArray's arrayWithArray:xs)'s ¬ sortedArrayUsingSelector:"compare:") as list
end sort
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
if 0 < n then items 1 thru min(n, length of xs) of xs else {} end if
end take
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation -- of a list of strings with the newline character. set {dlm, my text item delimiters} to ¬ {my text item delimiters, linefeed} set s to xs as text set my text item delimiters to dlm s
end unlines
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
set lng to min(|length|(xs), |length|(ys)) if 1 > lng then return {} set xs_ to take(lng, xs) -- Allow for non-finite set ys_ to take(lng, ys) -- generators like cycle etc set lst to {} tell mReturn(f) repeat with i from 1 to lng set end of lst to |λ|(item i of xs_, item i of ys_) end repeat return lst end tell
end zipWith</lang>
- Output:
17 matches: eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
AWK
<lang AWK>
- syntax: GAWK -f WORD_WHEEL.AWK letters unixdict.txt
- the required letter must be first
- example: GAWK -f WORD_WHEEL.AWK Kndeogelw unixdict.txt
BEGIN {
letters = tolower(ARGV[1]) required = substr(letters,1,1) size = 3 ARGV[1] = ""
} { word = tolower($0)
leng_word = length(word) if (word ~ required && leng_word >= size) { hits = 0 for (i=1; i<=leng_word; i++) { if (letters ~ substr(word,i,1)) { hits++ } } if (leng_word == hits && hits >= size) { for (i=1; i<=leng_word; i++) { c = substr(word,i,1) if (gsub(c,"&",word) > gsub(c,"&",letters)) { next } } words++ printf("%s ",word) } }
} END {
printf("\nletters: %s, '%s' required, %d words >= %d characters\n",letters,required,words,size) exit(0)
} </lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke letters: kndeogelw, 'k' required, 17 words >= 3 characters
BASIC
<lang BASIC>10 DEFINT A-Z 20 DATA "ndeokgelw","unixdict.txt" 30 READ WH$, F$ 40 OPEN "I",1,F$ 50 IF EOF(1) THEN CLOSE 1: END 60 C$ = WH$ 70 LINE INPUT #1, W$ 80 FOR I=1 TO LEN(W$) 90 FOR J=1 TO LEN(C$) 100 IF MID$(W$,I,1)=MID$(C$,J,1) THEN MID$(C$,J,1)="@": GOTO 120 110 NEXT J: GOTO 50 120 NEXT I 130 IF MID$(C$,(LEN(C$)+1)/2,1)<>"@" GOTO 50 140 C=0: FOR I=1 TO LEN(C$): C=C-(MID$(C$,I,1)="@"): NEXT 150 IF C>=3 THEN PRINT W$, 160 GOTO 50</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
BCPL
<lang bcpl>get "libhdr"
// Read word from selected input let readword(v) = valof $( let ch = ?
v%0 := 0 $( ch := rdch() if ch = endstreamch then resultis false if ch = '*N' then resultis true v%0 := v%0 + 1 v%(v%0) := ch $) repeat
$)
// Test word against wheel let match(wheel, word) = valof $( let wcopy = vec 2+9/BYTESPERWORD
for i = 0 to wheel%0 do wcopy%i := wheel%i for i = 1 to word%0 do $( let idx = ? test valof $( for j = 1 to wcopy%0 do if word%i = wcopy%j then $( idx := j resultis true $) resultis false $) then wcopy%idx := 0 // we've used this letter else resultis false // word cannot be made $) resultis wcopy%((wcopy%0+1)/2)=0 & // middle letter must be used 3 <= valof // at least 3 letters must be used $( let count = 0 for i = 1 to wcopy%0 do if wcopy%i=0 then count := count + 1 resultis count $)
$)
// Test unixdict.txt against ndeokgelw let start() be $( let word = vec 2+64/BYTESPERWORD
let file = findinput("unixdict.txt") let wheel = "ndeokgelw" selectinput(file) while readword(word) do if match(wheel, word) do writef("%S*N", word) endread()
$)</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
C
<lang c>#include <stdbool.h>
- include <stdio.h>
- define MAX_WORD 80
- define LETTERS 26
bool is_letter(char c) { return c >= 'a' && c <= 'z'; }
int index(char c) { return c - 'a'; }
void word_wheel(const char* letters, char central, int min_length, FILE* dict) {
int max_count[LETTERS] = { 0 }; for (const char* p = letters; *p; ++p) { char c = *p; if (is_letter(c)) ++max_count[index(c)]; } char word[MAX_WORD + 1] = { 0 }; while (fgets(word, MAX_WORD, dict)) { int count[LETTERS] = { 0 }; for (const char* p = word; *p; ++p) { char c = *p; if (c == '\n') { if (p >= word + min_length && count[index(central)] > 0) printf("%s", word); } else if (is_letter(c)) { int i = index(c); if (++count[i] > max_count[i]) { break; } } else { break; } } }
}
int main(int argc, char** argv) {
const char* dict = argc == 2 ? argv[1] : "unixdict.txt"; FILE* in = fopen(dict, "r"); if (in == NULL) { perror(dict); return 1; } word_wheel("ndeokgelw", 'k', 3, in); fclose(in); return 0;
}</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
C++
The puzzle parameters can be set with command line options. The default values are as per the task description. <lang cpp>#include <array>
- include <iostream>
- include <fstream>
- include <map>
- include <string>
- include <vector>
- include <boost/program_options.hpp>
// A multiset specialized for strings consisting of lowercase // letters ('a' to 'z'). class letterset { public:
letterset() { count_.fill(0); } explicit letterset(const std::string& str) { count_.fill(0); for (char c : str) add(c); } bool contains(const letterset& set) const { for (size_t i = 0; i < count_.size(); ++i) { if (set.count_[i] > count_[i]) return false; } return true; } unsigned int count(char c) const { return count_[index(c)]; } bool is_valid() const { return count_[0] == 0; } void add(char c) { ++count_[index(c)]; }
private:
static bool is_letter(char c) { return c >= 'a' && c <= 'z'; } static int index(char c) { return is_letter(c) ? c - 'a' + 1 : 0; } // elements 1..26 contain the number of times each lowercase // letter occurs in the word // element 0 is the number of other characters in the word std::array<unsigned int, 27> count_;
};
template <typename iterator, typename separator> std::string join(iterator begin, iterator end, separator sep) {
std::string result; if (begin != end) { result += *begin++; for (; begin != end; ++begin) { result += sep; result += *begin; } } return result;
}
using dictionary = std::vector<std::pair<std::string, letterset>>;
dictionary load_dictionary(const std::string& filename, int min_length,
int max_length) { std::ifstream in(filename); if (!in) throw std::runtime_error("Cannot open file " + filename); std::string word; dictionary result; while (getline(in, word)) { if (word.size() < min_length) continue; if (word.size() > max_length) continue; letterset set(word); if (set.is_valid()) result.emplace_back(word, set); } return result;
}
void word_wheel(const dictionary& dict, const std::string& letters,
char central_letter) { letterset set(letters); if (central_letter == 0 && !letters.empty()) central_letter = letters.at(letters.size()/2); std::map<size_t, std::vector<std::string>> words; for (const auto& pair : dict) { const auto& word = pair.first; const auto& subset = pair.second; if (subset.count(central_letter) > 0 && set.contains(subset)) words[word.size()].push_back(word); } size_t total = 0; for (const auto& p : words) { const auto& v = p.second; auto n = v.size(); total += n; std::cout << "Found " << n << " " << (n == 1 ? "word" : "words") << " of length " << p.first << ": " << join(v.begin(), v.end(), ", ") << '\n'; } std::cout << "Number of words found: " << total << '\n';
}
void find_max_word_count(const dictionary& dict, int word_length) {
size_t max_count = 0; std::vector<std::pair<std::string, char>> max_words; for (const auto& pair : dict) { const auto& word = pair.first; if (word.size() != word_length) continue; const auto& set = pair.second; dictionary subsets; for (const auto& p : dict) { if (set.contains(p.second)) subsets.push_back(p); } letterset done; for (size_t index = 0; index < word_length; ++index) { char central_letter = word[index]; if (done.count(central_letter) > 0) continue; done.add(central_letter); size_t count = 0; for (const auto& p : subsets) { const auto& subset = p.second; if (subset.count(central_letter) > 0) ++count; } if (count > max_count) { max_words.clear(); max_count = count; } if (count == max_count) max_words.emplace_back(word, central_letter); } } std::cout << "Maximum word count: " << max_count << '\n'; std::cout << "Words of " << word_length << " letters producing this count:\n"; for (const auto& pair : max_words) std::cout << pair.first << " with central letter " << pair.second << '\n';
}
constexpr const char* option_filename = "filename"; constexpr const char* option_wheel = "wheel"; constexpr const char* option_central = "central"; constexpr const char* option_min_length = "min-length"; constexpr const char* option_part2 = "part2";
int main(int argc, char** argv) {
const int word_length = 9; int min_length = 3; std::string letters = "ndeokgelw"; std::string filename = "unixdict.txt"; char central_letter = 0; bool do_part2 = false; namespace po = boost::program_options; po::options_description desc("Allowed options"); desc.add_options() (option_filename, po::value<std::string>(), "name of dictionary file") (option_wheel, po::value<std::string>(), "word wheel letters") (option_central, po::value<char>(), "central letter (defaults to middle letter of word)") (option_min_length, po::value<int>(), "minimum word length") (option_part2, "include part 2");
try { po::variables_map vm; po::store(po::parse_command_line(argc, argv, desc), vm); po::notify(vm);
if (vm.count(option_filename)) filename = vm[option_filename].as<std::string>(); if (vm.count(option_wheel)) letters = vm[option_wheel].as<std::string>(); if (vm.count(option_central)) central_letter = vm[option_central].as<char>(); if (vm.count(option_min_length)) min_length = vm[option_min_length].as<int>(); if (vm.count(option_part2)) do_part2 = true;
auto dict = load_dictionary(filename, min_length, word_length); // part 1 word_wheel(dict, letters, central_letter); // part 2 if (do_part2) { std::cout << '\n'; find_max_word_count(dict, word_length); } } catch (const std::exception& ex) { std::cerr << ex.what() << '\n'; return EXIT_FAILURE; } return EXIT_SUCCESS;
}</lang>
- Output:
Output including optional part 2:
Found 5 words of length 3: eke, elk, keg, ken, wok Found 10 words of length 4: keel, keen, keno, knee, knew, know, kong, leek, week, woke Found 1 word of length 5: kneel Found 1 word of length 9: knowledge Number of words found: 17 Maximum word count: 215 Words of 9 letters producing this count: claremont with central letter a spearmint with central letter a
Delphi
<lang Delphi> program Word_wheel;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
function IsInvalid(s: string): Boolean; var
c: char; leters: set of char; firstE: Boolean;
begin
Result := (s.Length < 3) or (s.IndexOf('k') = -1) or (s.Length > 9); if not Result then begin leters := ['d', 'e', 'g', 'k', 'l', 'n', 'o', 'w']; firstE := true; for c in s do begin if c in leters then if (c = 'e') and (firstE) then firstE := false else Exclude(leters, AnsiChar(c)) else exit(true); end; end;
end;
var
dict: TStringList; i: Integer;
begin
dict := TStringList.Create; dict.LoadFromFile('unixdict.txt');
for i := dict.count - 1 downto 0 do if IsInvalid(dict[i]) then dict.Delete(i);
Writeln('The following ', dict.Count, ' words are the solutions to the puzzle:'); Writeln(dict.Text);
dict.Free; readln;
end.
</lang>
Factor
<lang factor>USING: assocs io.encodings.ascii io.files kernel math math.statistics prettyprint sequences sorting ;
! Only consider words longer than two letters and words that ! contain elt.
- pare ( elt seq -- new-seq )
[ [ member? ] keep length 2 > and ] with filter ;
- words ( input-str path -- seq )
[ [ midpoint@ ] keep nth ] [ ascii file-lines pare ] bi* ;
- ?<= ( m n/f -- ? ) dup f = [ nip ] [ <= ] if ;
! Can we make sequence 1 with the elements in sequence 2?
- can-make? ( seq1 seq2 -- ? )
[ histogram ] bi@ [ swapd at ?<= ] curry assoc-all? ;
- solve ( input-str path -- seq )
[ words ] keepd [ can-make? ] curry filter ;
"ndeokgelw" "unixdict.txt" solve [ length ] sort-with .</lang>
- Output:
{ "eke" "elk" "keg" "ken" "wok" "keel" "keen" "keno" "knee" "knew" "know" "kong" "leek" "week" "woke" "kneel" "knowledge" }
FreeBASIC
<lang freebasic>
- include "file.bi"
Function String_Split(s_in As String,chars As String,result() As String) As Long
Dim As Long ctr,ctr2,k,n,LC=Len(chars) Dim As boolean tally(Len(s_in)) #macro check_instring() n=0 While n<Lc If chars[n]=s_in[k] Then tally(k)=true If (ctr2-1) Then ctr+=1 ctr2=0 Exit While End If n+=1 Wend #endmacro #macro split() If tally(k) Then If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1) ctr2=0 End If #endmacro '================== LOOP TWICE ======================= For k =0 To Len(s_in)-1 ctr2+=1:check_instring() Next k if ctr=0 then if len(s_in) andalso instr(chars,chr(s_in[0])) then ctr=1':beep end if If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else Return 0 For k =0 To Len(s_in)-1 ctr2+=1:split() Next k '===================== Last one ======================== If ctr2>0 Then Redim Preserve result(1 To ctr+1) result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2) End If Return Ubound(result)
End Function
Function loadfile(file As String) As String If Fileexists(file)=0 Then Print file;" not found":Sleep:End
Dim As Long f=Freefile Open file For Binary Access Read As #f Dim As String text If Lof(f) > 0 Then text = String(Lof(f), 0) Get #f, , text End If Close #f Return text
End Function
Function tally(SomeString As String,PartString As String) As Long
Dim As Long LenP=Len(PartString),count Dim As Long position=Instr(SomeString,PartString) If position=0 Then Return 0 While position>0 count+=1 position=Instr(position+LenP,SomeString,PartString) Wend Return count
End Function
Sub show(g As String,file As String,byref matches as long,minsize as long,mustdo as string)
Redim As String s() Var L=lcase(loadfile(file)) g=lcase(g) string_split(L,Chr(10),s()) For m As Long=minsize To len(g) For n As Long=Lbound(s) To Ubound(s) If Len(s(n))=m Then For k As Long=0 To m-1 If Instr(g,Chr(s(n)[k]))=0 Then Goto lbl Next k If Instr(s(n),mustdo) Then For j As Long=0 To Len(s(n))-1 If tally(s(n),Chr(s(n)[j]))>tally(g,Chr(s(n)[j])) Then Goto lbl Next j Print s(n) matches+=1 End If End If lbl: Next n Next m
End Sub
dim as long matches dim as double t=timer show("ndeokgelw","unixdict.txt",matches,3,"k") print print "Overall time taken ";timer-t;" seconds" print matches;" matches" Sleep </lang>
- Output:
eke elk keg ken wok keel keen keno knee knew know kong leek week woke kneel knowledge Overall time taken 0.02187220007181168 seconds 17 matches
Go
<lang go>package main
import (
"bytes" "fmt" "io/ioutil" "log" "sort" "strings"
)
func main() {
b, err := ioutil.ReadFile("unixdict.txt") if err != nil { log.Fatal("Error reading file") } letters := "deegklnow" wordsAll := bytes.Split(b, []byte{'\n'}) // get rid of words under 3 letters or over 9 letters var words [][]byte for _, word := range wordsAll { word = bytes.TrimSpace(word) le := len(word) if le > 2 && le < 10 { words = append(words, word) } } var found []string for _, word := range words { le := len(word) if bytes.IndexByte(word, 'k') >= 0 { lets := letters ok := true for i := 0; i < le; i++ { c := word[i] ix := sort.Search(len(lets), func(i int) bool { return lets[i] >= c }) if ix < len(lets) && lets[ix] == c { lets = lets[0:ix] + lets[ix+1:] } else { ok = false break } } if ok { found = append(found, string(word)) } } } fmt.Println("The following", len(found), "words are the solutions to the puzzle:") fmt.Println(strings.Join(found, "\n"))
// optional extra mostFound := 0 var mostWords9 []string var mostLetters []byte // extract 9 letter words var words9 [][]byte for _, word := range words { if len(word) == 9 { words9 = append(words9, word) } } // iterate through them for _, word9 := range words9 { letterBytes := make([]byte, len(word9)) copy(letterBytes, word9) sort.Slice(letterBytes, func(i, j int) bool { return letterBytes[i] < letterBytes[j] }) // get distinct bytes distinctBytes := []byte{letterBytes[0]} for _, b := range letterBytes[1:] { if b != distinctBytes[len(distinctBytes)-1] { distinctBytes = append(distinctBytes, b) } } distinctLetters := string(distinctBytes) for _, letter := range distinctLetters { found := 0 letterByte := byte(letter) for _, word := range words { le := len(word) if bytes.IndexByte(word, letterByte) >= 0 { lets := string(letterBytes) ok := true for i := 0; i < le; i++ { c := word[i] ix := sort.Search(len(lets), func(i int) bool { return lets[i] >= c }) if ix < len(lets) && lets[ix] == c { lets = lets[0:ix] + lets[ix+1:] } else { ok = false break } } if ok { found = found + 1 } } } if found > mostFound { mostFound = found mostWords9 = []string{string(word9)} mostLetters = []byte{letterByte} } else if found == mostFound { mostWords9 = append(mostWords9, string(word9)) mostLetters = append(mostLetters, letterByte) } } } fmt.Println("\nMost words found =", mostFound) fmt.Println("Nine letter words producing this total:") for i := 0; i < len(mostWords9); i++ { fmt.Println(mostWords9[i], "with central letter", string(mostLetters[i])) }
}</lang>
- Output:
The following 17 words are the solutions to the puzzle: eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke Most words found = 215 Nine letter words producing this total: claremont with central letter a spearmint with central letter a
Haskell
<lang haskell>import Data.Char (toLower) import Data.List (sort) import System.IO (readFile)
WORD WHEEL ----------------------
gridWords :: [String] -> [String] -> [String] gridWords grid =
filter ( ((&&) . (2 <) . length) <*> (((&&) . elem mid) <*> wheelFit wheel) ) where cs = toLower <$> concat grid wheel = sort cs mid = cs !! 4
wheelFit :: String -> String -> Bool wheelFit wheel word = go wheel (sort word)
where go _ [] = True go [] _ = False go (w : ws) ccs@(c : cs) | w == c = go ws cs | otherwise = go ws ccs
TEST -------------------------
main :: IO () main =
readFile "unixdict.txt" >>= ( mapM_ putStrLn . gridWords ["NDE", "OKG", "ELW"] . lines )</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
JavaScript
A version using local access to the dictionary, through the macOS JavaScript for Automation API.
<lang JavaScript>(() => {
'use strict';
// main :: IO () const main = () => console.log(unlines( gridWords(['NDE', 'OKG', 'ELW'])( lines(readFile('unixdict.txt')) ) ));
// gridWords :: [String] -> [String] -> [String] const gridWords = grid => lexemes => { const wheel = sort(toLower(concat(grid))), wSet = new Set(wheel), mid = wheel[4]; return lexemes.filter(w => { const cs = chars(w); return 2 < cs.length && cs.every( c => wSet.has(c) ) && elem(mid)(cs) && ( wheelFit(wheel, cs) ); }); };
// wheelFit :: [Char] -> [Char] -> Bool const wheelFit = (wheel, word) => { const go = (ws, cs) => 0 === cs.length ? ( true ) : 0 === ws.length ? ( false ) : ws[0] === cs[0] ? ( go(ws.slice(1), cs.slice(1)) ) : go(ws.slice(1), cs); return go(wheel, sort(word)); };
// ----------------- GENERIC FUNCTIONS -----------------
// chars :: String -> [Char] const chars = s => s.split();
// concat :: a -> [a] // concat :: [String] -> String const concat = xs => ( ys => 0 < ys.length ? ( ys.every(Array.isArray) ? ( [] ) : ).concat(...ys) : ys )(list(xs));
// elem :: Eq a => a -> [a] -> Bool const elem = x => // True if xs contains an instance of x. xs => xs.some(y => x === y);
// lines :: String -> [String] const lines = s => // A list of strings derived from a single // newline-delimited string. 0 < s.length ? ( s.split(/[\r\n]/) ) : [];
// list :: StringOrArrayLike b => b -> [a] const list = xs => // xs itself, if it is an Array, // or an Array derived from xs. Array.isArray(xs) ? ( xs ) : Array.from(xs || []);
// readFile :: FilePath -> IO String const readFile = fp => { // The contents of a text file at the // path file fp. const e = $(), ns = $.NSString .stringWithContentsOfFileEncodingError( $(fp).stringByStandardizingPath, $.NSUTF8StringEncoding, e ); return ObjC.unwrap( ns.isNil() ? ( e.localizedDescription ) : ns ); };
// sort :: Ord a => [a] -> [a] const sort = xs => list(xs).slice() .sort((a, b) => a < b ? -1 : (a > b ? 1 : 0));
// toLower :: String -> String const toLower = s => // Lower-case version of string. s.toLocaleLowerCase();
// unlines :: [String] -> String const unlines = xs => // A single string formed by the intercalation // of a list of strings with the newline character. xs.join('\n');
// MAIN --- return main();
})();</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Julia
<lang julia>using Combinatorics
const tfile = download("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt") const wordlist = Dict(w => 1 for w in split(read(tfile, String), r"\s+"))
function wordwheel(wheel, central)
returnlist = String[] for combo in combinations([string(i) for i in wheel]) if central in combo && length(combo) > 2 for perm in permutations(combo) word = join(perm) if haskey(wordlist, word) && !(word in returnlist) push!(returnlist, word) end end end end return returnlist
end
println(wordwheel("ndeokgelw", "k"))
</lang>
- Output:
["ken", "keg", "eke", "elk", "wok", "keno", "knee", "keen", "knew", "kong", "know", "woke", "keel", "leek", "week", "kneel", "knowledge"]
Faster but less general version
<lang julia>const tfile = download("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt") const wordarraylist = [[string(c) for c in w] for w in split(read(tfile, String), r"\s+")]
function wordwheel2(wheel, central)
warr, maxlen = [string(c) for c in wheel], length(wheel) returnarraylist = filter(a -> 2 < length(a) <= maxlen && central in a && all(c -> sum(x -> x == c, a) <= sum(x -> x == c, warr), a), wordarraylist) return join.(returnarraylist)
end
println(wordwheel2("ndeokgelw", "k"))
</lang>
- Output:
["eke", "elk", "keel", "keen", "keg", "ken", "keno", "knee", "kneel", "knew", "know", "knowledge", "kong", "leek", "week", "wok", "woke"]
Lua
<lang lua>LetterCounter = {
new = function(self, word) local t = { word=word, letters={} } for ch in word:gmatch(".") do t.letters[ch] = (t.letters[ch] or 0) + 1 end return setmetatable(t, self) end, contains = function(self, other) for k,v in pairs(other.letters) do if (self.letters[k] or 0) < v then return false end end return true end
} LetterCounter.__index = LetterCounter
grid = "ndeokgelw" midl = grid:sub(5,5) ltrs = LetterCounter:new(grid) file = io.open("unixdict.txt", "r") for word in file:lines() do
if #word >= 3 and word:find(midl) and ltrs:contains(LetterCounter:new(word)) then print(word) end
end</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Nim
<lang Nim>import strutils, sugar, tables
const Grid = """N D E
O K G E L W"""
let letters = Grid.toLowerAscii.splitWhitespace.join()
let words = collect(newSeq):
for word in "unixdict.txt".lines: if word.len in 3..9: word
let midLetter = letters[4]
let gridCount = letters.toCountTable for word in words:
block checkWord: if midLetter in word: for ch, count in word.toCountTable.pairs: if count > gridCount[ch]: break checkWord echo word</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Pascal
<lang Pascal> program WordWheel;
{$mode objfpc}{$H+}
uses
Classes, SysUtils;
const
WheelSize = 9; MinLength = 3; WordFile = 'unixdict.txt';
procedure search(pattern : string); var
Allowed, Required, Available, w : string; Len, i, p : integer; WordList : TextFile; Match : boolean;
begin
AssignFile(WordList, WordFile); try Reset(WordList); except writeln('Could not open dictionary file ' + WordFile); exit; end; Allowed := LowerCase(pattern); Required := copy(Allowed, 5, 1); { central letter is required } while not eof(WordList) do begin readln(WordList, w); Len := length(w); if (Len < MinLength) or (Len > WheelSize) then continue; if pos(Required, w) = 0 then continue; Available := Allowed; Match := True; for i := 1 to Len do begin p := pos(w[i], Available); if p > 0 then { prevent re-use of letter } delete(Available, p, 1) else begin Match := False; break; end; end; if Match then writeln(w); end;
end;
{ exercise the procedure } begin
search('NDE' + 'OKG' + 'ELW'); {3 x 3 letter grid }
end. </lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Perl
UPDATED: this version builds a single regex that will select all valid words straight from the file string. <lang perl>#!/usr/bin/perl
use strict; # https://rosettacode.org/wiki/Word_wheel use warnings;
$_ = <<END;
N D E O K G E L W
END
my $file = do { local(@ARGV, $/) = 'unixdict.txt'; <> }; my $length = my @letters = lc =~ /\w/g; my $center = $letters[@letters / 2]; my $toomany = (join , sort @letters) =~ s/(.)\1*/
my $count = length "$1$&"; "(?!(?:.*$1){$count})" /ger;
my $valid = qr/^(?=.*$center)$toomany([@letters]{3,$length}$)$/m;
my @words = $file =~ /$valid/g;
print @words . " words for\n$_\n@words\n" =~ s/.{60}\K /\n/gr;</lang>
- Output:
17 words for N D E O K G E L W eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Phix
requires("0.8.2") -- (fixed some glitches in join_by()) constant wheel = "ndeokgelw", musthave = wheel[5] sequence words = {}, word9 = {} -- (for the optional extra part) integer fn = open(join_path({"demo","unixdict.txt"}),"r") if fn=-1 then crash("unixdict.txt not found") end if while 1 do object word = lower(trim(gets(fn))) if atom(word) then exit end if -- eof integer lw = length(word) if lw>=3 then if lw<=9 then word9 = append(word9,word) end if if find(musthave,word) then string remaining = wheel while lw do integer k = find(word[lw],remaining) if k=0 then exit end if remaining[k] = '\0' -- (prevent re-use) lw -= 1 end while if lw=0 then words = append(words,word) end if end if end if end while close(fn) string jbw = join_by(words,1,9," ","\n ") printf(1, "The following %d words were found:\n %s\n",{length(words),jbw}) -- optional extra integer mostFound = 0 sequence mostWheels = {}, mustHaves = {} for i=1 to length(word9) do string try_wheel = word9[i] if length(try_wheel)=9 then string musthaves = unique(try_wheel) for j=1 to length(musthaves) do integer found = 0 for k=1 to length(word9) do string word = word9[k] if find(musthaves[j],word) then string rest = try_wheel bool ok = true for c=1 to length(word) do integer ix = find(word[c],rest) if ix=0 then ok = false exit end if rest[ix] = '\0' end for found += ok end if end for printf(1,"working (%s)\r",{try_wheel}) if found>mostFound then mostFound = found mostWheels = {try_wheel} mustHaves = {musthaves[j]} elsif found==mostFound then mostWheels = append(mostWheels,try_wheel) mustHaves = append(mustHaves,musthaves[j]) end if end for end if end for printf(1,"Most words found = %d\n",mostFound) printf(1,"Nine letter words producing this total:\n") for i=1 to length(mostWheels) do printf(1,"%s with central letter '%c'\n",{mostWheels[i],mustHaves[i]}) end for
- Output:
The following 17 words were found: eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke Most words found = 215 Nine letter words producing this total: claremont with central letter 'a' spearmint with central letter 'a'
PureBasic
<lang PureBasic>Procedure.b check_word(word$)
Shared letters$ If Len(word$)<3 Or FindString(word$,"k")<1 ProcedureReturn #False EndIf For i=1 To Len(word$) If CountString(letters$,Mid(word$,i,1))<CountString(word$,Mid(word$,i,1)) ProcedureReturn #False EndIf Next ProcedureReturn #True
EndProcedure
If ReadFile(0,"./Data/unixdict.txt")
txt$=LCase(ReadString(0,#PB_Ascii|#PB_File_IgnoreEOL)) CloseFile(0)
EndIf
If OpenConsole()
letters$="ndeokgelw" wordcount=1 Repeat buf$=StringField(txt$,wordcount,~"\n") wordcount+1 If check_word(buf$)=#False Continue EndIf PrintN(buf$) : r+1 Until buf$="" PrintN("- Finished: "+Str(r)+" words found -") Input()
EndIf End</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke - Finished: 17 words found -
Python
<lang python>import urllib.request from collections import Counter
GRID = """
N D E
O K G
E L W
"""
def getwords(url='http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'):
"Return lowercased words of 3 to 9 characters" words = urllib.request.urlopen(url).read().decode().strip().lower().split() return (w for w in words if 2 < len(w) < 10)
def solve(grid, dictionary):
gridcount = Counter(grid) mid = grid[4] return [word for word in dictionary if mid in word and not (Counter(word) - gridcount)]
if __name__ == '__main__':
chars = .join(GRID.strip().lower().split()) found = solve(chars, dictionary=getwords()) print('\n'.join(found))</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Or, using a local copy of the dictionary, and a recursive test of wheel fit:
<lang python>Word wheel
from os.path import expanduser
- gridWords :: [String] -> [String] -> [String]
def gridWords(grid):
The subset of words in ws which contain the central letter of the grid, and can be completed by single uses of some or all of the remaining letters in the grid. def go(ws): cs = .join(grid).lower() wheel = sorted(cs) wset = set(wheel) mid = cs[4] return [ w for w in ws if 2 < len(w) and (mid in w) and ( all(c in wset for c in w) ) and wheelFit(wheel, w) ] return go
- wheelFit :: String -> String -> Bool
def wheelFit(wheel, word):
True if a given word can be constructed from (single uses of) some subset of the letters in the wheel. def go(ws, cs): return True if not cs else ( False if not ws else ( go(ws[1:], cs[1:]) if ws[0] == cs[0] else ( go(ws[1:], cs) ) ) ) return go(wheel, sorted(word))
- -------------------------- TEST --------------------------
- main :: IO ()
def main():
Word wheel matches for a given grid in a copy of http://wiki.puzzlers.org/pub/wordlists/unixdict.txt print('\n'.join( gridWords(['NDE', 'OKG', 'ELW'])( readFile('~/unixdict.txt').splitlines() ) ))
- ------------------------ GENERIC -------------------------
- readFile :: FilePath -> IO String
def readFile(fp):
The contents of any file at the path derived by expanding any ~ in fp. with open(expanduser(fp), 'r', encoding='utf-8') as f: return f.read()
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
q
<lang q>ce:count each lc:ce group@ / letter count dict:"\n"vs .Q.hg "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" // dictionary of 3-9 letter words d39:{x where(ce x)within 3 9}{x where all each x in .Q.a}dict
solve:{[grid;dict]
i:where(grid 4)in'dict; dict i where all each 0<=(lc grid)-/:lc each dict i }[;d39]</lang>
<lang q>q)`$solve "ndeokglew" `eke`elk`keel`keen`keg`ken`keno`knee`kneel`knew`know`knowledge`kong`leek`week`wok`woke</lang> A naive solution to the second question is simple <lang q>bust:{[dict]
grids:distinct raze(til 9)rotate\:/:dict where(ce dict)=9; wc:(count solve@)each grids; grids where wc=max wc }</lang>
but inefficient. Better: <lang q>best:{[dict]
dlc:lc each dict; / letter counts of dictionary words ig:where(ce dict)=9; / find grids (9-letter words) igw:where each(all)0<=(dlc ig)-/:\:dlc; / find words composable from each grid (length ig) grids:raze(til 9)rotate\:/:dict ig; / 9 permutations of each grid iaz:(.Q.a)!where each .Q.a in'\:dict; / find words containing a, b, c etc ml:4 rotate'dict ig; / mid letters for each grid wc:ce raze igw inter/:'iaz ml; / word counts for grids distinct grids where wc=max wc } / grids with most words</lang>
<lang q>q)show w:best d39 "ntclaremo" "tspearmin"
q)ce solve each w 215 215</lang> Full discussion at code.kx.com
Raku
Everything is adjustable through command line parameters.
Defaults to task specified wheel, unixdict.txt, minimum 3 letters.
Using Terminal::Boxer from the Raku ecosystem.
<lang perl6>use Terminal::Boxer;
my %*SUB-MAIN-OPTS = :named-anywhere;
unit sub MAIN ($wheel = 'ndeokgelw', :$dict = './unixdict.txt', :$min = 3);
my $must-have = $wheel.comb[4].lc;
my $has = $wheel.comb».lc.Bag;
my %words; $dict.IO.slurp.words».lc.map: {
next if not .contains($must-have) or .chars < $min; %words{.chars}.push: $_ if .comb.Bag ⊆ $has;
};
say "Using $dict, minimum $min letters.";
print rs-box :3col, :3cw, :indent("\t"), $wheel.comb».uc;
say "{sum %words.values».elems} words found";
printf "%d letters: %s\n", .key, .value.sort.join(', ') for %words.sort;</lang>
- Output:
<lang>raku word-wheel.raku</lang>
Using ./unixdict.txt, minimum 3 letters. ╭───┬───┬───╮ │ N │ D │ E │ ├───┼───┼───┤ │ O │ K │ G │ ├───┼───┼───┤ │ E │ L │ W │ ╰───┴───┴───╯ 17 words found 3 letters: eke, elk, keg, ken, wok 4 letters: keel, keen, keno, knee, knew, know, kong, leek, week, woke 5 letters: kneel 9 letters: knowledge
- Larger dictionary
Using the much larger dictionary words.txt file from https://github.com/dwyl/english-words
<lang>raku word-wheel.raku --dict=./words.txt</lang>
Using ./words.txt, minimum 3 letters. ╭───┬───┬───╮ │ N │ D │ E │ ├───┼───┼───┤ │ O │ K │ G │ ├───┼───┼───┤ │ E │ L │ W │ ╰───┴───┴───╯ 86 words found 3 letters: dkg, dkl, eek, egk, eke, ekg, elk, gok, ked, kee, keg, kel, ken, keo, kew, kln, koe, kol, kon, lek, lgk, nek, ngk, oke, owk, wok 4 letters: deek, deke, doek, doke, donk, eked, elke, elko, geek, genk, gonk, gowk, keel, keen, keld, kele, kend, keno, keon, klee, knee, knew, know, koel, koln, kone, kong, kwon, leek, leke, loke, lonk, okee, oken, week, welk, woke, wolk, wonk 5 letters: dekle, dekow, gleek, kedge, kendo, kleon, klong, kneed, kneel, knowe, konde, oklee, olnek, woken 6 letters: gowked, keldon, kelwen, knowle, koleen 8 letters: weeklong 9 letters: knowledge
- Top 5 maximum word wheels with at least one 9 letter word
Using unixdict.txt:
Wheel words eimnaprst: 215 celmanort: 215 ceimanrst: 210 elmnaoprt: 208 ahlneorst: 201
Using words.txt:
Wheel words meilanrst: 1329 deilanrst: 1313 ceilanrst: 1301 peilanrst: 1285 geilanrst: 1284
REXX
Quite a bit of boilerplate was included in this REXX example.
No assumption was made as the "case" of the words (upper/lower/mixed case). Duplicate
words were detected and
eliminated (god and God), as well as words that didn't contain
all Roman (Latin) letters.
The number of minimum letters can be specified, as well as the dictionary fileID and the letters in the word wheel (grid).
Additional information is also provided concerning how many words have been skipped due to the various filters. <lang rexx>/*REXX pgm finds (dictionary) words which can be found in a specified word wheel (grid).*/ parse arg grid minL iFID . /*obtain optional arguments from the CL*/ if grid==|grid=="," then grid= 'ndeokgelw' /*Not specified? Then use the default.*/ if minL==|minL=="," then minL= 3 /* " " " " " " */ if iFID==|iFID=="," then iFID= 'UNIXDICT.TXT' /* " " " " " " */ oMinL= minL; minL= abs(minL) /*if negative, then don't show a list. */ gridU= grid; upper gridU /*get an uppercase version of the grid.*/ Lg= length(grid); Hg= Lg % 2 + 1 /*get length of grid & the middle char.*/ ctr= substr(grid, Hg, 1); upper ctr /*get uppercase center letter in grid. */ wrds= 0 /*# words that are in the dictionary. */ wees= 0 /*" " " " too short. */ bigs= 0 /*" " " " too long. */ dups= 0 /*" " " " duplicates. */ ills= 0 /*" " " contain "not" letters.*/ good= 0 /*" " " contain center letter. */ nine= 0 /*" wheel─words that contain 9 letters.*/ say ' Reading the file: ' iFID /*align the text. */ @.= . /*uppercase non─duplicated dict. words.*/ $= /*the list of dictionary words in grid.*/
do recs=0 while lines(iFID)\==0 /*process all words in the dictionary. */ u= space( linein(iFID), 0); upper u /*elide blanks; uppercase the word. */ L= length(u) /*obtain the length of the word. */ if @.u\==. then do; dups= dups+1; iterate; end /*is this a duplicate? */ if L<minL then do; wees= wees+1; iterate; end /*is the word too short? */ if L>Lg then do; bigs= bigs+1; iterate; end /*is the word too long? */ if \datatype(u,'M') then do; ills= ills+1; iterate; end /*has word non─letters? */ @.u= /*signify that U is a dictionary word*/ wrds= wrds + 1 /*bump the number of "good" dist. words*/ if pos(ctr, u)==0 then iterate /*word doesn't have center grid letter.*/ good= good + 1 /*bump # center─letter words in dict. */ if verify(u, gridU)\==0 then iterate /*word contains a letter not in grid. */ if pruned(u, gridU) then iterate /*have all the letters not been found? */ if L==9 then nine= nine + 1 /*bump # words that have nine letters. */ $= $ u /*add this word to the "found" list. */ end /*recs*/
say say ' number of records (words) in the dictionary: ' right( commas(recs), 9) say ' number of ill─formed words in the dictionary: ' right( commas(ills), 9) say ' number of duplicate words in the dictionary: ' right( commas(dups), 9) say ' number of too─small words in the dictionary: ' right( commas(wees), 9) say ' number of too─long words in the dictionary: ' right( commas(bigs), 9) say ' number of acceptable words in the dictionary: ' right( commas(wrds), 9) say ' number center─letter words in the dictionary: ' right( commas(good), 9) say ' the minimum length of words that can be used: ' right( commas(minL), 9) say ' the word wheel (grid) being used: ' grid say ' center of the word wheel (grid) being used: ' right('↑', Hg) say; #= words($); $= strip($) say ' number of word wheel words in the dictionary: ' right( commas(# ), 9) say ' number of nine-letter wheel words found: ' right( commas(nine), 9) if #==0 | oMinL<0 then exit # say say ' The list of word wheel words found:'; say copies('─', length($)); say lower($) exit # /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ lower: arg aa; @='abcdefghijklmnopqrstuvwxyz'; @u=@; upper @u; return translate(aa,@,@U) commas: parse arg _; do jc=length(_)-3 to 1 by -3; _=insert(',', _, jc); end; return _ /*──────────────────────────────────────────────────────────────────────────────────────*/ pruned: procedure; parse arg aa,gg /*obtain word to be tested, & the grid.*/
do n=1 for length(aa); p= pos( substr(aa,n,1), gg); if p==0 then return 1 gg= overlay(., gg, p) /*"rub out" the found character in grid*/ end /*n*/; return 0 /*signify that the AA passed the test*/</lang>
- output when using the default inputs:
Reading the file: UNIXDICT.TXT number of records (lines) in the dictionary: 25,105 number of ill─formed words in the dictionary: 123 number of duplicate words in the dictionary: 0 number of too─small words in the dictionary: 159 number of too─long words in the dictionary: 4,158 number of acceptable words in the dictionary: 20,664 number center─letter words in the dictionary: 1,630 the minimum length of words that can be used: 3 the word wheel (grid) being used: ndeokgelw center of the word wheel (grid) being used: ↑ number of word wheel words in the dictionary: 17 number of nine-letter wheel words found: 1 The list of word wheel words found: ───────────────────────────────────────────────────────────────────────────────────── eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Note: my "personal" dictionary that I built (over 915,000 947,359 words), there are 178 words that are in the (above) word wheel.
- output when using the inputs: satRELinp -3
(I am trying for a maximum word wheel count for the UNIXDICT dictionary;
the negative minimum word length indicates to not list the words found.)
Thanks to userid Paddy3118, a better grid was found.
Reading the file: UNIXDICT.TXT number of records (lines) in the dictionary: 25,105 number of ill─formed words in the dictionary: 123 number of duplicate words in the dictionary: 0 number of too─small words in the dictionary: 159 number of too─long words in the dictionary: 4,158 number of acceptable words in the dictionary: 20,664 number center─letter words in the dictionary: 11,623 the minimum length of words that can be used: 3 the word wheel (grid) being used: satRELinp center of the word wheel (grid) being used: ↑ number of word wheel words in the dictionary: 234 number of nine-letter wheel words found: 0
- output when using the inputs: setRALinp -3
Thanks to userid Simonjsaunders, a better grid was found.
Reading the file: UNIXDICT.TXT number of records (words) in the dictionary: 25,104 number of ill─formed words in the dictionary: 123 number of duplicate words in the dictionary: 0 number of too─small words in the dictionary: 159 number of too─long words in the dictionary: 4,158 number of acceptable words in the dictionary: 20,664 number center─letter words in the dictionary: 10,369 the minimum length of words that can be used: 3 the word wheel (grid) being used: setRALinp center of the word wheel (grid) being used: ↑ number of word wheel words in the dictionary: 248 number of nine-letter wheel words found: 0
Ruby
<lang ruby>wheel = "ndeokgelw" middle, wheel_size = wheel[4], wheel.size
res = File.open("unixdict.txt").each_line.select do |word|
w = word.chomp next unless w.size.between?(3, wheel_size) next unless w.match?(middle) wheel.each_char{|c| w.sub!(c, "") } #sub! substitutes only the first occurrence (gsub would substitute all) w.empty?
end
puts res </lang>
- Output:
eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke
Wren
<lang ecmascript>import "io" for File import "/sort" for Sort, Find import "/seq" for Lst
var letters = ["d", "e", "e", "g", "k", "l", "n", "o","w"]
var words = File.read("unixdict.txt").split("\n") // get rid of words under 3 letters or over 9 letters words = words.where { |w| w.count > 2 && w.count < 10 }.toList var found = [] for (word in words) {
if (word.indexOf("k") >= 0) { var lets = letters.toList var ok = true for (c in word) { var ix = Find.first(lets, c) if (ix == - 1) { ok = false break } lets.removeAt(ix) } if (ok) found.add(word) }
}
System.print("The following %(found.count) words are the solutions to the puzzle:") System.print(found.join("\n"))
// optional extra var mostFound = 0 var mostWords9 = [] var mostLetters = [] // iterate through all 9 letter words in the dictionary for (word9 in words.where { |w| w.count == 9 }) {
letters = word9.toList Sort.insertion(letters) // get distinct letters var distinctLetters = Lst.distinct(letters) // place each distinct letter in the middle and see what we can do with the rest for (letter in distinctLetters) { found = 0 for (word in words) { if (word.indexOf(letter) >= 0) { var lets = letters.toList var ok = true for (c in word) { var ix = Find.first(lets, c) if (ix == - 1) { ok = false break } lets.removeAt(ix) } if (ok) found = found + 1 } } if (found > mostFound) { mostFound = found mostWords9 = [word9] mostLetters = [letter] } else if (found == mostFound) { mostWords9.add(word9) mostLetters.add(letter) } }
} System.print("\nMost words found = %(mostFound)") System.print("Nine letter words producing this total:") for (i in 0...mostWords9.count) {
System.print("%(mostWords9[i]) with central letter '%(mostLetters[i])'")
}</lang>
- Output:
The following 17 words are the solutions to the puzzle: eke elk keel keen keg ken keno knee kneel knew know knowledge kong leek week wok woke Most words found = 215 Nine letter words producing this total: claremont with central letter 'a' spearmint with central letter 'a'