I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

Word wheel

From Rosetta Code
Task
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.


Other tasks related to string operations:
Metrics
Counting
Remove/replace
Anagrams/Derangements/shuffling
Find/Search/Determine
Formatting
Song lyrics/poems/Mad Libs/phrases
Tokenize
Sequences



8080 Assembly[edit]

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).

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
Output:
A>wheel unixdict.txt ndeokgelw
eke
elk
keel
keen
keg
ken
keno
knee
kneel
knew
know
knowledge
kong
leek
week
wok
woke

AppleScript[edit]

use AppleScript version "2.4"
use framework "Foundation"
use scripting additions
 
--------------------------- TEST ---------------------------
on run
 
unlines(gridWords({"NDE", "OKG", "ELW"}, ¬
paragraphs of readFile("~/Desktop/unixdict.txt")))
 
end run
 
 
----------------------- WHEEL WORDS ------------------------
 
-- gridWords :: [String] -> [String] -> [String]
on gridWords(grid, lexemes)
set wheel to sort(characters of toLower(concat(grid)))
set mid to item (1 + ((length of wheel) div 2)) of wheel
 
script p
on |λ|(c)
wheel contains c
end |λ|
end script
 
script match
on |λ|(w)
set cs to characters of w
2 < length of cs and all(p, cs) and ¬
cs contains mid and wheelFit(wheel, cs)
end |λ|
end script
filter(match, lexemes)
end gridWords
 
 
-- wheelFit :: [Char] -> [Char] -> Bool
on wheelFit(wheel, w)
script go
on |λ|(ws, cs)
if {} = cs then
true
else if {} = ws then
false
else if item 1 of ws = item 1 of cs then
|λ|(rest of ws, rest of cs)
else
|λ|(rest of ws, cs)
end if
end |λ|
end script
 
tell go to |λ|(wheel, sort(w))
end wheelFit
 
 
------------------------- GENERIC --------------------------
 
-- 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
 
 
-- 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
return lst
end tell
end filter
 
 
-- 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
 
 
-- readFile :: FilePath -> IO String
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 as string
else
(localizedDescription of e) as string
end if
end readFile
 
 
-- sort :: Ord a => [a] -> [a]
on sort(xs)
((current application's NSArray's arrayWithArray:xs)'s ¬
sortedArrayUsingSelector:"compare:") as list
end sort
 
 
-- toLower :: String -> String
on toLower(str)
-- String in lower case.
set ca to current application
((ca's NSString's stringWithString:(str))'s ¬
lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toLower
 
 
-- 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
Output:
eke
elk
keel
keen
keg
ken
keno
knee
kneel
knew
know
knowledge
kong
leek
week
wok
woke

C[edit]

#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;
}
Output:
eke
elk
keel
keen
keg
ken
keno
knee
kneel
knew
know
knowledge
kong
leek
week
wok
woke

C++[edit]

Library: Boost

The puzzle parameters can be set with command line options. The default values are as per the task description.

#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;
}
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[edit]

Translation of: Wren
 
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.
 
 

Factor[edit]

Works with: Factor version 0.99 2020-07-03
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 )
[ [ [email protected] ] 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 ] [email protected] [ swapd at ?<= ] curry assoc-all? ;
 
: solve ( input-str path -- seq )
[ words ] keepd [ can-make? ] curry filter ;
 
"ndeokgelw" "unixdict.txt" solve [ length ] sort-with .
Output:
{
    "eke"
    "elk"
    "keg"
    "ken"
    "wok"
    "keel"
    "keen"
    "keno"
    "knee"
    "knew"
    "know"
    "kong"
    "leek"
    "week"
    "woke"
    "kneel"
    "knowledge"
}

Go[edit]

Translation of: Wren
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]))
}
}
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[edit]

import System.IO (readFile)
import Data.Char (toLower)
import Data.List (sort)
 
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
 
main :: IO ()
main = do
s <- readFile "unixdict.txt"
mapM_ putStrLn $ gridWords ["NDE", "OKG", "ELW"] (lines s)
Output:
eke
elk
keel
keen
keg
ken
keno
knee
kneel
knew
know
knowledge
kong
leek
week
wok
woke

JavaScript[edit]

A version using local access to the dictionary, through the macOS JavaScript for Automation API.

Works with: JXA
(() => {
'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();
})();
Output:
eke
elk
keel
keen
keg
ken
keno
knee
kneel
knew
know
knowledge
kong
leek
week
wok
woke

Julia[edit]

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"))
 
Output:
["ken", "keg", "eke", "elk", "wok", "keno", "knee", "keen", "knew", "kong", "know", "woke", "keel", "leek", "week", "kneel", "knowledge"]

Faster but less general version[edit]

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"))
 
Output:
["eke", "elk", "keel", "keen", "keg", "ken", "keno", "knee", "kneel", "knew", "know", "knowledge", "kong", "leek", "week", "wok", "woke"]

Perl[edit]

UPDATED: this version builds a single regex that will select all valid words straight from the file string.

#!/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;
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[edit]

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'

Python[edit]

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))
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:

'''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()
Output:
eke
elk
keel
keen
keg
ken
keno
knee
kneel
knew
know
knowledge
kong
leek
week
wok
woke

Raku[edit]

Works with: Rakudo version 2020.05

Everything is adjustable through command line parameters.

Defaults to task specified wheel, unixdict.txt, minimum 3 letters.

Using Terminal::Boxer from the Raku ecosystem.

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;
Output:
Using defaults
raku word-wheel.raku
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

raku word-wheel.raku --dict=./words.txt
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[edit]

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.

/*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'; @[email protected]; 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*/
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

Wren[edit]

Library: Wren-sort
Library: Wren-seq
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])'")
}
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'