Rosetta Code

Teacup rim text: Difference between revisions

Page Discussion

Teacup rim text (view source)

Revision as of 11:40, 13 February 2024

44,773 bytes added ,  3 months ago
m
→‎{{header|Wren}}: Minor tidy
(→‎{{header|Go}}: Generalized to use multiple dictionaries following latest task change.)
m (→‎{{header|Wren}}: Minor tidy)
 
(65 intermediate revisions by 22 users not shown)
Line 1:
{{draft task|Teacup rim text}}
 
On a set of coasters we have, there's a picture of a teacup.   On the rim of the teacup the word "  '''TEA"'''   appears a number of times separated by bullet characters. It  occurred to me that if the bullet were removed and the words run together, you could start at any letter and still end up with a meaningful three-letter word(•). So start at the "T" and read "TEA". Start at the "E" and read "EAT", or start at the "A" and read "ATE".
 
It occurred to me that if the bullet were removed and the words run together,   you could start at any letter and still end up with a meaningful three-letter word.
That got me thinking that maybe there are other words that could be used rather that "TEA". And that's just English. What about Italian or Greek or ... um ... Telugu. For English, we use the unixdict (now) located at http://wiki.puzzlers.org/pub/wordlists/unixdict.txt . (This maintains continuity with other RC tasks that also use it.)
 
So start at the   '''T'''   and read   '''TEA'''.   Start at the   '''E'''   and read   '''EAT''',   or start at the   '''A'''   and read   '''ATE'''.
So here's the task: You're in search of a set of words that could be printed around the edge of a teacup. The words in each set are to be of the same length, that length being greater than two (thus precluding AH and HA, for example.) Having listed a set, for example [ate tea eat], refrain from displaying permutations of that set, e.g. [eat tea ate] etc. The words should also be made of more than one letter (thus precluding III and OOO etc.)
 
That got me thinking that maybe there are other words that could be used rather that   '''TEA'''.   And that's just English.   What about Italian or Greek or ... um ... Telugu.
The relationship between these words is (using ATE as an example) that the first letter of the first becomes the last letter of the second. The first letter of the second becomes the last letter of the third. So ATE becomes TEA and TEA becomes EAT. All of the possible permutations, using this particular permutation technique, must be words in the list. The set you generate for ATE will never included the word ETA as that cannot be reached via the first-to-last movement method.
 
For English, we will use the unixdict (now) located at:   [http://wiki.puzzlers.org/pub/wordlists/unixdict.txt unixdict.txt].
Display one line for each set of teacup rim words.
 
(This will maintain continuity with other Rosetta Code tasks that also use it.)
 
 
;Task:
Search for a set of words that could be printed around the edge of a teacup.   The words in each set are to be of the same length, that length being greater than two (thus precluding   '''AH'''   and   '''HA''',   for example.)
 
Having listed a set, for example   ['''ate tea eat'''],   refrain from displaying permutations of that set, e.g.:   ['''eat tea ate''']   etc.
 
The words should also be made of more than one letter   (thus precluding   '''III'''   and   '''OOO'''   etc.)
 
The relationship between these words is (using ATE as an example) that the first letter of the first becomes the last letter of the second.   The first letter of the second becomes the last letter of the third.   So   '''ATE'''   becomes   '''TEA'''   and   '''TEA'''   becomes   '''EAT'''.
 
All of the possible permutations, using this particular permutation technique, must be words in the list.
 
The set you generate for   '''ATE'''   will never included the word   '''ETA'''   as that cannot be reached via the first-to-last movement method.
 
Display one line for each set of teacup rim words.
 
 
{{Template:Strings}}
<br><br>
 
=={{header|11l}}==
<syntaxhighlight lang="11l">F rotated(String s)
R s[1..]‘’s[0]
 
V s = Set(File(‘unixdict.txt’).read().rtrim("\n").split("\n"))
L !s.empty
L(=word) s // `=` is needed here because otherwise after `s.remove(word)` `word` becomes invalid
s.remove(word)
I word.len < 3
L.break
 
V w = word
L 0 .< word.len - 1
w = rotated(w)
I w C s
s.remove(w)
E
L.break
L.was_no_break
print(word, end' ‘’)
w = word
L 0 .< word.len - 1
w = rotated(w)
print(‘ -> ’w, end' ‘’)
print()
 
L.break</syntaxhighlight>
 
{{out}}
<pre>
apt -> pta -> tap
arc -> rca -> car
ate -> tea -> eat
</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">wordset: map read.lines relative "unixdict.txt" => strip
 
rotateable?: function [w][
loop 1..dec size w 'i [
rotated: rotate w i
if or? [rotated = w][not? contains? wordset rotated] ->
return false
]
return true
]
 
results: new []
loop select wordset 'word [3 =< size word] 'word [
if rotateable? word ->
'results ++ @[ sort map 1..size word 'i [ rotate word i ]]
]
 
loop sort unique results 'result [
root: first result
print join.with: " -> " map 1..size root 'i [ rotate.left root i]
]</syntaxhighlight>
 
{{out}}
 
<pre>tea -> eat -> ate
rca -> car -> arc
pta -> tap -> apt</pre>
 
=={{header|AutoHotkey}}==
<syntaxhighlight lang="autohotkey">Teacup_rim_text(wList){
oWord := [], oRes := [], n := 0
for i, w in StrSplit(wList, "`n", "`r")
if StrLen(w) >= 3
oWord[StrLen(w), w] := true
for l, obj in oWord
{
for w, bool in obj
{
loop % l
if oWord[l, rotate(w)]
{
oWord[l, w] := 0
if (A_Index = 1)
n++, oRes[n] := w
if (A_Index < l)
oRes[n] := oRes[n] "," (w := rotate(w))
}
if (StrSplit(oRes[n], ",").Count() <> l)
oRes.RemoveAt(n)
}
}
return oRes
}
 
rotate(w){
return SubStr(w, 2) . SubStr(w, 1, 1)
}</syntaxhighlight>
Examples:<syntaxhighlight lang="autohotkey">FileRead, wList, % A_Desktop "\unixdict.txt"
result := ""
for i, v in Teacup_rim_text(wList)
result .= v "`n"
MsgBox % result
return</syntaxhighlight>
{{out}}
<pre>apt,pta,tap
arc,rca,car
ate,tea,eat</pre>
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
# syntax: GAWK -f TEACUP_RIM_TEXT.AWK UNIXDICT.TXT
#
# sorting:
# PROCINFO["sorted_in"] is used by GAWK
# SORTTYPE is used by Thompson Automation's TAWK
#
{ for (i=1; i<=NF; i++) {
arr[tolower($i)] = 0
}
}
END {
PROCINFO["sorted_in"] = "@ind_str_asc" ; SORTTYPE = 1
for (i in arr) {
leng = length(i)
if (leng > 2) {
delete tmp_arr
words = str = i
tmp_arr[i] = ""
for (j=2; j<=leng; j++) {
str = substr(str,2) substr(str,1,1)
if (str in arr) {
words = words " " str
tmp_arr[str] = ""
}
}
if (length(tmp_arr) == leng) {
count = 0
for (j in tmp_arr) {
(arr[j] == 0) ? arr[j]++ : count++
}
if (count == 0) {
printf("%s\n",words)
circular++
}
}
}
}
printf("%d words, %d circular\n",length(arr),circular)
exit(0)
}
</syntaxhighlight>
{{out}}
<p>using UNIXDICT.TXT</p>
<pre>
apt pta tap
arc rca car
ate tea eat
25104 words, 3 circular
</pre>
<p>using MIT10000.TXT</p>
<pre>
aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
10000 words, 5 circular
</pre>
 
=={{header|BaCon}}==
<syntaxhighlight lang="bacon">OPTION COLLAPSE TRUE
 
dict$ = LOAD$(DIRNAME$(ME$) & "/unixdict.txt")
 
FOR word$ IN dict$ STEP NL$
IF LEN(word$) = 3 AND AMOUNT(UNIQ$(EXPLODE$(word$, 1))) = 3 THEN domain$ = APPEND$(domain$, 0, word$)
NEXT
 
FOR w1$ IN domain$
w2$ = RIGHT$(w1$, 2) & LEFT$(w1$, 1)
w3$ = RIGHT$(w2$, 2) & LEFT$(w2$, 1)
IF TALLY(domain$, w2$) AND TALLY(domain$, w3$) AND NOT(TALLY(result$, w1$)) THEN
result$ = APPEND$(result$, 0, w1$ & " " & w2$ & " " & w3$, NL$)
ENDIF
NEXT
 
PRINT result$
PRINT "Total words: ", AMOUNT(dict$, NL$), ", and ", AMOUNT(result$, NL$), " are circular."</syntaxhighlight>
{{out}}
Using 'unixdict.txt':
<pre>apt pta tap
arc rca car
ate tea eat
Total words: 25104, and 3 are circular.</pre>
Using 'wordlist.10000':
<pre>aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
Total words: 10000, and 5 are circular.
</pre>
 
=={{header|C}}==
{{libheader|GLib}}
<syntaxhighlight lang="c">#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <glib.h>
 
int string_compare(gconstpointer p1, gconstpointer p2) {
const char* const* s1 = p1;
const char* const* s2 = p2;
return strcmp(*s1, *s2);
}
 
GPtrArray* load_dictionary(const char* file, GError** error_ptr) {
GError* error = NULL;
GIOChannel* channel = g_io_channel_new_file(file, "r", &error);
if (channel == NULL) {
g_propagate_error(error_ptr, error);
return NULL;
}
GPtrArray* dict = g_ptr_array_new_full(1024, g_free);
GString* line = g_string_sized_new(64);
gsize term_pos;
while (g_io_channel_read_line_string(channel, line, &term_pos,
&error) == G_IO_STATUS_NORMAL) {
char* word = g_strdup(line->str);
word[term_pos] = '\0';
g_ptr_array_add(dict, word);
}
g_string_free(line, TRUE);
g_io_channel_unref(channel);
if (error != NULL) {
g_propagate_error(error_ptr, error);
g_ptr_array_free(dict, TRUE);
return NULL;
}
g_ptr_array_sort(dict, string_compare);
return dict;
}
 
void rotate(char* str, size_t len) {
char c = str[0];
memmove(str, str + 1, len - 1);
str[len - 1] = c;
}
 
char* dictionary_search(const GPtrArray* dictionary, const char* word) {
char** result = bsearch(&word, dictionary->pdata, dictionary->len,
sizeof(char*), string_compare);
return result != NULL ? *result : NULL;
}
 
void find_teacup_words(GPtrArray* dictionary) {
GHashTable* found = g_hash_table_new(g_str_hash, g_str_equal);
GPtrArray* teacup_words = g_ptr_array_new();
GString* temp = g_string_sized_new(8);
for (size_t i = 0, n = dictionary->len; i < n; ++i) {
char* word = g_ptr_array_index(dictionary, i);
size_t len = strlen(word);
if (len < 3 || g_hash_table_contains(found, word))
continue;
g_ptr_array_set_size(teacup_words, 0);
g_string_assign(temp, word);
bool is_teacup_word = true;
for (size_t i = 0; i < len - 1; ++i) {
rotate(temp->str, len);
char* w = dictionary_search(dictionary, temp->str);
if (w == NULL) {
is_teacup_word = false;
break;
}
if (strcmp(word, w) != 0 && !g_ptr_array_find(teacup_words, w, NULL))
g_ptr_array_add(teacup_words, w);
}
if (is_teacup_word && teacup_words->len > 0) {
printf("%s", word);
g_hash_table_add(found, word);
for (size_t i = 0; i < teacup_words->len; ++i) {
char* teacup_word = g_ptr_array_index(teacup_words, i);
printf(" %s", teacup_word);
g_hash_table_add(found, teacup_word);
}
printf("\n");
}
}
g_string_free(temp, TRUE);
g_ptr_array_free(teacup_words, TRUE);
g_hash_table_destroy(found);
}
 
int main(int argc, char** argv) {
if (argc != 2) {
fprintf(stderr, "usage: %s dictionary\n", argv[0]);
return EXIT_FAILURE;
}
GError* error = NULL;
GPtrArray* dictionary = load_dictionary(argv[1], &error);
if (dictionary == NULL) {
if (error != NULL) {
fprintf(stderr, "Cannot load dictionary file '%s': %s\n",
argv[1], error->message);
g_error_free(error);
}
return EXIT_FAILURE;
}
find_teacup_words(dictionary);
g_ptr_array_free(dictionary, TRUE);
return EXIT_SUCCESS;
}</syntaxhighlight>
 
{{out}}
With unixdict.txt:
<pre>
apt pta tap
arc rca car
ate tea eat
</pre>
With wordlist.10000:
<pre>
aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
</pre>
 
=={{header|C++}}==
<syntaxhighlight lang="cpp">#include <algorithm>
#include <fstream>
#include <iostream>
#include <set>
#include <string>
#include <vector>
 
// filename is expected to contain one lowercase word per line
std::set<std::string> load_dictionary(const std::string& filename) {
std::ifstream in(filename);
if (!in)
throw std::runtime_error("Cannot open file " + filename);
std::set<std::string> words;
std::string word;
while (getline(in, word))
words.insert(word);
return words;
}
 
void find_teacup_words(const std::set<std::string>& words) {
std::vector<std::string> teacup_words;
std::set<std::string> found;
for (auto w = words.begin(); w != words.end(); ++w) {
std::string word = *w;
size_t len = word.size();
if (len < 3 || found.find(word) != found.end())
continue;
teacup_words.clear();
teacup_words.push_back(word);
for (size_t i = 0; i + 1 < len; ++i) {
std::rotate(word.begin(), word.begin() + 1, word.end());
if (word == *w || words.find(word) == words.end())
break;
teacup_words.push_back(word);
}
if (teacup_words.size() == len) {
found.insert(teacup_words.begin(), teacup_words.end());
std::cout << teacup_words[0];
for (size_t i = 1; i < len; ++i)
std::cout << ' ' << teacup_words[i];
std::cout << '\n';
}
}
}
 
int main(int argc, char** argv) {
if (argc != 2) {
std::cerr << "usage: " << argv[0] << " dictionary\n";
return EXIT_FAILURE;
}
try {
find_teacup_words(load_dictionary(argv[1]));
} catch (const std::exception& ex) {
std::cerr << ex.what() << '\n';
return EXIT_FAILURE;
}
return EXIT_SUCCESS;
}</syntaxhighlight>
 
{{out}}
With unixdict.txt:
<pre>
apt pta tap
arc rca car
ate tea eat
</pre>
With wordlist.10000:
<pre>
aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
</pre>
 
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight lang="fsharp">
// Teacup rim text. Nigel Galloway: August 7th., 2019
let N=System.IO.File.ReadAllLines("dict.txt")|>Array.filter(fun n->String.length n=3 && Seq.length(Seq.distinct n)>1)|>Set.ofArray
let fG z=Set.map(fun n->System.String(Array.ofSeq (Seq.permute(fun g->(g+z)%3)n))) N
Set.intersectMany [N;fG 1;fG 2]|>Seq.distinctBy(Seq.sort>>Array.ofSeq>>System.String)|>Seq.iter(printfn "%s")
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 28 ⟶ 453:
 
=={{header|Factor}}==
<langsyntaxhighlight lang="factor">USING: combinators.short-circuit fry grouping hash-sets
http.client kernel math prettyprint sequences sequences.extras
sets sorting splitting ;
Line 35 ⟶ 460:
"\n" split [ { [ length 3 < ] [ all-equal? ] } 1|| ] reject
[ [ all-rotations ] map ] [ >hash-set ] bi
'[ [ _ in? ] all? ] filter [ natural-sort ] map members .</langsyntaxhighlight>
{{out}}
<pre>
Line 48 ⟶ 473:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 117 ⟶ 542:
fmt.Println()
}
}</langsyntaxhighlight>
 
{{out}}
Line 139 ⟶ 564:
===Using Data.Set===
Circular words of more than 2 characters in a local copy of a word list.
<langsyntaxhighlight lang="haskell">import Data.List (groupBy, intercalate, sort, sortBy)
import qualified Data.Set as S
import Data.Ord (comparing)
Line 169 ⟶ 594:
filter
((1 <) . length)
(groupBy (on (==) fst) (sortBy (comparing fst) (((,) =<< sort) <$> xs)))</langsyntaxhighlight>
{{Out}}
<pre>arc -> car -> rca
Line 180 ⟶ 605:
 
Or taking a different approach, we can avoid the use of Data.Set by obtaining the groups of anagrams (of more than two characters) in the lexicon, and filtering out a circular subset of these:
<syntaxhighlight lang ="haskell">import Data.ListFunction (groupBy, intercalate, sort, sortByon)
import Data.List (groupBy, intercalate, sort, sortOn)
import Data.Ord (comparing)
import Data.Function (on)
import Data.Bool (bool)
 
main :: IO ()
main =
readFile "mitWords.txt" >>=
>>= ( putStrLn
(putStrLn .
. unlines
unlines . fmap (intercalate " -> ") . (circularOnly =<<) . anagrams . lines)
. fmap (intercalate " -> ")
. (circularOnly =<<)
. anagrams
. lines
)
 
anagrams :: [String] -> [[String]]
anagrams ws =
let harvest group px
groupBy (on (==) fst) (sortBy (comparing fst) (((,) =<< sort) <$> ws)) >>=
(bool [] . return . fmap snd)| <*>px ((>= 2)[fmap .snd length)group]
| otherwise = []
in groupBy
(on (==) fst)
(sortOn fst (((,) =<< sort) <$> ws))
>>= (harvest <*> ((> 2) . length))
 
circularOnly :: [String] -> [[String]]
circularOnly ws =
| (length h - 1) > length rs = []
let h = head ws
| lngotherwise = length [h -: 1rs]
where
rs = filter (isRotation h) (tail ws)
h = head ws
in bool [h : rs] [] (lng > length rs)
rs = filter (isRotation h) (tail ws)
 
isRotation :: String -> String -> Bool
isRotation xs ys = xs /= until ((||) . (ys ==) <*> (xs ==)) rotated (rotated xs)
xs
/= until
( (||)
. (ys ==)
<*> (xs ==)
)
rotated
(rotated xs)
 
rotated :: [a] -> [a]
rotated [] = []
rotated (x : xs) = tail xs ++<> [head xsx]</langsyntaxhighlight>
{{Out}}
<pre>arc -> rca -> car
Line 215 ⟶ 658:
asp -> spa -> pas
ips -> psi -> sip</pre>
 
=={{header|J}}==
<syntaxhighlight lang="j"> >@{.@> (#~ (=&#>@{.)@> * 2 < #@>)(</.~ {.@/:~@(|."0 1~ i.@#)L:0)cutLF fread'unixdict.txt'
apt
arc
ate</syntaxhighlight>
 
In other words, group words by their canonical rotation (from all rotations: the earliest, alphabetically), select groups with at least three different words, where the word count matches the letter count, then extract the first word from each group.
 
=={{header|Java}}==
{{trans|C++}}
<syntaxhighlight lang="java">import java.io.*;
import java.util.*;
 
public class Teacup {
public static void main(String[] args) {
if (args.length != 1) {
System.err.println("usage: java Teacup dictionary");
System.exit(1);
}
try {
findTeacupWords(loadDictionary(args[0]));
} catch (Exception ex) {
System.err.println(ex.getMessage());
}
}
 
// The file is expected to contain one lowercase word per line
private static Set<String> loadDictionary(String fileName) throws IOException {
Set<String> words = new TreeSet<>();
try (BufferedReader reader = new BufferedReader(new FileReader(fileName))) {
String word;
while ((word = reader.readLine()) != null)
words.add(word);
return words;
}
}
 
private static void findTeacupWords(Set<String> words) {
List<String> teacupWords = new ArrayList<>();
Set<String> found = new HashSet<>();
for (String word : words) {
int len = word.length();
if (len < 3 || found.contains(word))
continue;
teacupWords.clear();
teacupWords.add(word);
char[] chars = word.toCharArray();
for (int i = 0; i < len - 1; ++i) {
String rotated = new String(rotate(chars));
if (rotated.equals(word) || !words.contains(rotated))
break;
teacupWords.add(rotated);
}
if (teacupWords.size() == len) {
found.addAll(teacupWords);
System.out.print(word);
for (int i = 1; i < len; ++i)
System.out.print(" " + teacupWords.get(i));
System.out.println();
}
}
}
 
private static char[] rotate(char[] ch) {
char c = ch[0];
System.arraycopy(ch, 1, ch, 0, ch.length - 1);
ch[ch.length - 1] = c;
return ch;
}
}</syntaxhighlight>
 
{{out}}
With unixdict.txt:
<pre>
apt pta tap
arc rca car
ate tea eat
</pre>
With wordlist.10000:
<pre>
aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
</pre>
 
=={{header|JavaScript}}==
Line 220 ⟶ 750:
Reading a local dictionary with the macOS JS for Automation library:
{{Works with|JXA}}
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 377 ⟶ 907:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>arc -> car -> rca
Line 388 ⟶ 918:
Reading a local dictionary with the macOS JS for Automation library:
{{Works with|JXA}}
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 527 ⟶ 1,057:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>arc -> rca -> car
Line 534 ⟶ 1,064:
asp -> spa -> pas
ips -> psi -> sip</pre>
 
=={{header|jq}}==
{{works with|jq}}
'''Works with gojq, the Go implementation of jq''' (*)
 
(*) To run the program below using gojq, change `keys_unsorted` to
`keys`; this slows it down a lot.
 
<syntaxhighlight lang="jq"># Output: an array of the words when read around the rim
def read_teacup:
. as $in
| [range(0; length) | $in[.:] + $in[:.] ];
 
# Boolean
def is_teacup_word($dict):
. as $in
| all( range(1; length); . as $i | $dict[ $in[$i:] + $in[:$i] ]) ;
 
# Output: a stream of the eligible teacup words
def teacup_words:
def same_letters:
explode
| .[0] as $first
| all( .[1:][]; . == $first);
 
# Only consider one word in a teacup cycle
def consider: explode | .[0] == min;
 
# Create the dictionary
reduce (inputs
| select(length>2 and (same_letters|not))) as $w ( {};
.[$w]=true )
| . as $dict
| keys[]
| select(consider and is_teacup_word($dict)) ;
 
# The task:
teacup_words
| read_teacup</syntaxhighlight>
{{out}}
Invocation example: jq -nRc -f teacup-rim.jq unixdict.txt
<pre>
["apt","pta","tap"]
["arc","rca","car"]
["ate","tea","eat"]
</pre>
 
 
=={{header|Julia}}==
Using the MIT 10000 word list, and excluding words of less than three letters, to reduce output length.
<langsyntaxhighlight lang="julia">using HTTP
rotate(s, n) = String(circshift(Vector{UInt8}(s), n))
Line 552 ⟶ 1,129:
foreach(println, getteawords("https://www.mit.edu/~ecprice/wordlist.10000"))
</langsyntaxhighlight>{{out}}
<pre>
["aim", "ima", "mai"]
Line 566 ⟶ 1,143:
Using https://www.mit.edu/~ecprice/wordlist.10000 as per the Julia example.
 
<langsyntaxhighlight lang="javascript">
const wc = new CS.System.Net.WebClient();
const lines = wc.DownloadString("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt");
Line 595 ⟶ 1,172:
.filter(key => collection[key].length > 1)
.forEach(key => console.log("%s", collection[key].join(", ")));
</syntaxhighlight>
</lang>
<pre>
apt, pta, tap
Line 602 ⟶ 1,179:
</pre>
 
=={{header|PerlMathematica}}/{{header|Wolfram 6Language}}==
<syntaxhighlight lang="mathematica">ClearAll[Teacuppable]
{{works with|Rakudo|2019.07.1}}
TeacuppableHelper[set_List] := Module[{f, s},
Much of the previous exposition here is superfluous as the reference word list has changed.
f = First[set];
s = StringRotateLeft[f, #] & /@ Range[Length[set]];
Sort[s] == Sort[set]
]
Teacuppable[set_List] := Module[{ss, l},
l = StringLength[First[set]];
ss = Subsets[set, {l}];
Select[ss, TeacuppableHelper]
]
s = Import["http://wiki.puzzlers.org/pub/wordlists/unixdict.txt", "String"];
s //= StringSplit[#, "\n"] &;
s //= Select[StringLength /* GreaterThan[2]];
s //= Map[ToLowerCase];
s //= Map[{#, Sort[Characters[#]]} &];
s //= GatherBy[#, Last] &;
s //= Select[Length /* GreaterEqualThan[2]];
s = s[[All, All, 1]];
s //= Select[StringLength[First[#]] <= Length[#] &];
Flatten[Teacuppable /@ s, 1]</syntaxhighlight>
{{out}}
<pre>{{"apt", "pta", "tap"}, {"arc", "car", "rca"}, {"ate", "eat", "tea"}}</pre>
 
=={{header|Nim}}==
There doesn't seem to be any restriction that the word needs to consist only of lowercase letters, so words of any case are included. Since the example code specifically shows the example words (TEA, EAT, ATE) in uppercase, I elected to uppercase the found words.
 
<syntaxhighlight lang="nim">import sequtils, sets, sugar
<lang perl6>my %words;
'./wordlist.10000'.IO.slurp.words.map: { .chars < 3 ?? (next) !! %words{.uc.comb.sort.join}.push: .uc };
 
let words = collect(initHashSet, for word in "unixdict.txt".lines: {word})
my @teacups;
my %seen;
 
proc rotate(s: var string) =
for %words.values -> @these {
let first = s[0]
next if @these < 2;
for i in 1..s.high: s[i - 1] = s[i]
MAYBE: for @these {
s[^1] = first
 
var result: seq[string]
for word in "unixdict.txt".lines:
if word.len >= 3:
block checkWord:
var w = word
for _ in 1..w.len:
w.rotate()
if w notin words or w in result:
# Not present in dictionary or already encountered.
break checkWord
if word.anyIt(it != word[0]):
# More then one letter.
result.add word
 
for word in result:
var w = word
stdout.write w
for _ in 2..w.len:
w.rotate()
stdout.write " → ", w
echo()</syntaxhighlight>
 
{{out}}
<pre>apt → pta → tap
arc → rca → car
ate → tea → eat</pre>
 
=={{header|Perl}}==
{{trans|Raku}}
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'say';
use List::Util qw(uniqstr any);
 
my(%words,@teacups,%seen);
 
open my $fh, '<', 'ref/wordlist.10000';
while (<$fh>) {
chomp(my $w = uc $_);
next if length $w < 3;
push @{$words{join '', sort split //, $w}}, $w;}
 
for my $these (values %words) {
next if @$these < 3;
MAYBE: for (@$these) {
my $maybe = $_;
next if %$seen{$_};
my @print;
for ^my $maybei (0 .chars. length $maybe) {
if (any { $maybe ∈eq $_ } @$these) {
push @print.push:, $maybe;
$maybe = substr($maybe,1) .comb.list.rotate.join; substr($maybe,0,1)
} else {
@print = (); and next MAYBE
next MAYBE
}
}
if (@print.elems) {
push @teacups.push:, [@print];
%$seen{$_}++ for @print;
}
}
}
 
say .join(" ', ")', uniqstr @$_ for sort @teacups;</langsyntaxhighlight>
{{out}}
<pre>AIMARC, IMARCA, MAICAR
ARC, RCA, CAR
ASP, SPA, PAS
ATE, TEA, EAT
AIM, IMA, MAI
ASP, SPA, PAS
IPS, PSI, SIP</pre>
 
=={{header|Phix}}==
Filters anagram lists
<!--<syntaxhighlight lang="phix">-->
<span style="color: #008080;">procedure</span> <span style="color: #000000;">filter_set</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- anagrams is a (small) set of words that are all anagrams of each other
-- for example: {"angel","angle","galen","glean","lange"}
-- print any set(s) for which every rotation is also present (marking as
-- you go to prevent the same set appearing with each word being first)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">used</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #004600;">false</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">used</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">used</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">word</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">anagrams</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">word</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">r</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">word</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">word</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]&</span><span style="color: #000000;">word</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">,</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">used</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">res</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">teacup</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">filename</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">minlen</span><span style="color: #0000FF;">=</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">bool</span> <span style="color: #000000;">allow_mono</span><span style="color: #0000FF;">=</span><span style="color: #004600;">false</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">letters</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- a sorted word, eg "ate" -&gt; "aet".</span>
<span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span> <span style="color: #000080;font-style:italic;">-- in eg {{"aet","ate"},...} form</span>
<span style="color: #000000;">anagrams</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span> <span style="color: #000080;font-style:italic;">-- a set with same letters</span>
<span style="color: #000000;">last</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span> <span style="color: #000080;font-style:italic;">-- (for building such sets)</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">word</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"using %s"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">filename</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">fn</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">open</span><span style="color: #0000FF;">(</span><span style="color: #000000;">filename</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"r"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">fn</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #7060A8;">crash</span><span style="color: #0000FF;">(</span><span style="color: #000000;">filename</span><span style="color: #0000FF;">&</span><span style="color: #008000;">" not found"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">word</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">lower</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">trim</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">gets</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fn</span><span style="color: #0000FF;">)))</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)>=</span><span style="color: #000000;">minlen</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">letters</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">letters</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">word</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">close</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fn</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">", %d words read\n"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- group by anagram</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">letters</span><span style="color: #0000FF;">,</span><span style="color: #000000;">word</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">letters</span><span style="color: #0000FF;">=</span><span style="color: #000000;">last</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">anagrams</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">,</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">allow_mono</span> <span style="color: #008080;">or</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)>=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">last</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">filter_set</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">last</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">letters</span>
<span style="color: #000000;">anagrams</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">word</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">allow_mono</span> <span style="color: #008080;">or</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)>=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">last</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">filter_set</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">teacup</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">join_path</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"demo"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"unixdict.txt"</span><span style="color: #0000FF;">}))</span>
<span style="color: #000080;font-style:italic;">-- These match output from other entries:
--teacup(join_path({"demo","unixdict.txt"}),allow_mono:=true)
--teacup(join_path({"demo","rosetta","mit.wordlist.10000.txt"}))
--teacup(join_path({"demo","rosetta","words.txt"}),4,true)
-- Note that allow_mono is needed to display eg {"agag","gaga"}</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
using demo\unixdict.txt, 24948 words read
{"arc","rca","car"}
{"ate","tea","eat"}
{"apt","pta","tap"}
</pre>
 
=={{header|PicoLisp}}==
<syntaxhighlight lang="picolisp">(de rotw (W)
(let W (chop W)
(unless (or (apply = W) (not (cddr W)))
(make
(do (length W)
(link (pack (copy W)))
(rot W) ) ) ) ) )
(off D)
(put 'D 'v (cons))
(mapc
'((W)
(idx 'D (cons (hash W) W) T) )
(setq Words
(make (in "wordlist.10000" (while (line T) (link @)))) ) )
(mapc
println
(extract
'((W)
(let? Lst (rotw W)
(when
(and
(fully
'((L) (idx 'D (cons (hash L) L)))
Lst )
(not
(member (car Lst) (car (get 'D 'v))) ) )
(mapc
'((L) (push (get 'D 'v) L))
Lst )
Lst ) ) )
Words ) )</syntaxhighlight>
{{out}}
<pre>
("aim" "mai" "ima")
("arc" "car" "rca")
("asp" "pas" "spa")
("ate" "eat" "tea")
("ips" "sip" "psi")
</pre>
 
=={{header|PureBasic}}==
<syntaxhighlight lang="purebasic">DataSection
dname:
Data.s "./Data/unixdict.txt"
Data.s "./Data/wordlist.10000.txt"
Data.s ""
EndDataSection
 
EnableExplicit
Dim c.s{1}(2)
Define.s txt, bset, res, dn
Define.i i,q, cw
Restore dname : Read.s dn
While OpenConsole() And ReadFile(0,dn)
While Not Eof(0)
cw+1
txt=ReadString(0)
If Len(txt)=3 : bset+txt+";" : EndIf
Wend
CloseFile(0)
For i=1 To CountString(bset,";")
PokeS(c(),StringField(bset,i,";"))
If FindString(res,c(0)+c(1)+c(2)) : Continue : EndIf
If c(0)=c(1) Or c(1)=c(2) Or c(0)=c(2) : Continue : EndIf
If FindString(bset,c(1)+c(2)+c(0)) And FindString(bset,c(2)+c(0)+c(1))
res+c(0)+c(1)+c(2)+~"\t"+c(1)+c(2)+c(0)+~"\t"+c(2)+c(0)+c(1)+~"\n"
EndIf
Next
PrintN(res+Str(cw)+" words, "+Str(CountString(res,~"\n"))+" circular") : Input()
bset="" : res="" : cw=0
Read.s dn
Wend</syntaxhighlight>
{{out}}
<pre>apt pta tap
arc rca car
ate tea eat
25104 words, 3 circular
 
aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
10000 words, 5 circular</pre>
 
=={{header|Python}}==
===Functional===
Composing generic functions, and considering only anagram groups.
<langsyntaxhighlight lang="python">'''Teacup rim text'''
 
from itertools import chain, groupby
Line 676 ⟶ 1,487:
'''
def go(ws):
returndef concatMapf(xs):
lambda xs:return [
[snd(x) for x in xs]
] if n <= len(xs) >= len(xs[0][0]) else []
return concatMap(f)(groupBy(fst)(sorted(
groupBy[(fst)''.join(sorted(w)), w) for w in ws],
sorted(key=fst
)))
[(''.join(sorted(w)), w) for w in ws],
return go
key=fst
)
)
)
return lambda ws: go(ws)
 
 
Line 726 ⟶ 1,533:
(0, True, rotated(w))
)[1]
return go
 
return lambda s: go(s)
 
 
Line 747 ⟶ 1,553:
(using an empty list to represent computational failure).
'''
return lambdadef go(xs): list(
return chain.from_iterable(map(f, xs))
)return go
 
 
Line 764 ⟶ 1,570:
in terms of the key function f.
'''
return lambdadef go(xs): [
return [
list(x[1]) for x in groupby(xs, key=f)
list(x[1]) for x in groupby(xs, key=f)
]
]
return go
 
 
Line 818 ⟶ 1,626:
over a start value of x.
'''
def go(f, x):
def g(a, ix):
vdef = fh(a) if, i else x):
return (v, v = f(a) if i else x
return mapAccumL(gv, v)(x)(
range(0,return 1 + nmapAccumL(h)(x)(
)[ range(0, 1] + n)
return lambda f: lambda x: go(f, x )[1]
return g
return go
 
 
Line 833 ⟶ 1,643:
The initial seed value is x.
'''
def go(f, x):
v =def g(x):
while not p( v): = x
vwhile =not fp(v):
return v = f(v)
return lambda f: lambda x: go(f, x) return v
return g
return go
 
 
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>arc -> rca -> car
Line 850 ⟶ 1,662:
asp -> spa -> pas
ips -> psi -> sip</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2019.07.1}}
There doesn't seem to be any restriction that the word needs to consist only of lowercase letters, so words of any case are included. Since the example code specifically shows the example words (TEA, EAT, ATE) in uppercase, I elected to uppercase the found words.
 
As the specs keep changing, this version will accept ANY text file as its dictionary and accepts parameters to configure the minimum number of characters in a word to consider and whether to allow mono-character words.
 
Defaults to unixdict.txt, minimum 3 characters and mono-character 'words' disallowed. Feed a file name to use a different word list, an integer to --min-chars and/or a truthy value to --mono to allow mono-chars.
 
<syntaxhighlight lang="raku" line>my %*SUB-MAIN-OPTS = :named-anywhere;
 
unit sub MAIN ( $dict = 'unixdict.txt', :$min-chars = 3, :$mono = False );
 
my %words;
$dict.IO.slurp.words.map: { .chars < $min-chars ?? (next) !! %words{.uc.comb.sort.join}.push: .uc };
 
my @teacups;
my %seen;
 
for %words.values -> @these {
next if !$mono && @these < 2;
MAYBE: for @these {
my $maybe = $_;
next if %seen{$_};
my @print;
for ^$maybe.chars {
if $maybe ∈ @these {
@print.push: $maybe;
$maybe = $maybe.comb.list.rotate.join;
} else {
@print = ();
next MAYBE
}
}
if @print.elems {
@teacups.push: @print;
%seen{$_}++ for @print;
}
}
}
 
say .unique.join(", ") for sort @teacups;</syntaxhighlight>
{{out|Defaults}}
Command line: <tt>raku teacup.p6</tt>
<pre>APT, PTA, TAP
ARC, RCA, CAR
ATE, TEA, EAT</pre>
{{out|Allow mono-chars}}
Command line: <tt>raku teacup.p6 --mono=1</tt>
<pre>AAA
APT, PTA, TAP
ARC, RCA, CAR
ATE, TEA, EAT
III</pre>
{{out|Using a larger dictionary}}
words.txt file from https://github.com/dwyl/english-words
 
Command line: <tt>raku teacup.p6 words.txt --min-chars=4 --mono=Allow</tt>
<pre>AAAA
AAAAAA
ADAD, DADA
ADAR, DARA, ARAD, RADA
AGAG, GAGA
ALIT, LITA, ITAL, TALI
AMAN, MANA, ANAM, NAMA
AMAR, MARA, ARAM, RAMA
AMEL, MELA, ELAM, LAME
AMEN, MENA, ENAM, NAME
AMOR, MORA, ORAM, RAMO
ANAN, NANA
ANIL, NILA, ILAN, LANI
ARAR, RARA
ARAS, RASA, ASAR, SARA
ARIS, RISA, ISAR, SARI
ASEL, SELA, ELAS, LASE
ASER, SERA, ERAS, RASE
DENI, ENID, NIDE, IDEN
DOLI, OLID, LIDO, IDOL
EGOR, GORE, OREG, REGO
ENOL, NOLE, OLEN, LENO
ESOP, SOPE, OPES, PESO
ISIS, SISI
MMMM
MORO, OROM, ROMO, OMOR
OOOO</pre>
 
=={{header|REXX}}==
All words that contained non─letter (Latin) characters &nbsp; (periods, decimal digits, minus signs,
underbars, or embedded blanks) &nbsp; weren't considered as candidates for circular words.
<br>weren't considered as candidates for circular words.
 
Duplicated words (such as &nbsp; '''sop''' &nbsp; and &nbsp; '''SOP''') &nbsp; are ignored &nbsp; (just the 2<sup>nd</sup> and subsequent duplicated words are deleted).
 
All words in the dictionary are treated as caseless.
 
The dictionary wasn't assumed to be sorted in any way.
<langsyntaxhighlight lang="rexx">/*REXX pgm finds circular words (length>2), using a dictionary, suppress permutations.*/
parse arg iFID L . /*obtain optional arguments from the CL*/
if iFID==''|iFID=="," then iFID= 'wordlist.10k' /*Not specified? Then use the default.*/
Line 890 ⟶ 1,789:
end /*j*/
say
say cw ' circular words were found.' /*stick a fork in it, we're all done. */</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 903 ⟶ 1,802:
 
5 circular words were found.
</pre>
 
=={{header|Ruby}}==
"woordenlijst.txt" is a Dutch wordlist. It has 413125 words > 2 chars and takes about two minutes.
<syntaxhighlight lang="ruby">lists = ["unixdict.txt", "wordlist.10000", "woordenlijst.txt"]
 
lists.each do |list|
words = open(list).readlines( chomp: true).reject{|w| w.size < 3 }
grouped_by_size = words.group_by(&:size)
tea_words = words.filter_map do |word|
chars = word.chars
next unless chars.none?{|c| c < chars.first }
next if chars.uniq.size == 1
rotations = word.size.times.map {|i| chars.rotate(i).join }
rotations if rotations.all?{|rot| grouped_by_size[rot.size].include? rot }
end
puts "", list + ":"
tea_words.uniq(&:to_set).each{|ar| puts ar.join(", ") }
end
</syntaxhighlight>
{{out}}
<pre>
unixdict.txt:
apt, pta, tap
arc, rca, car
ate, tea, eat
 
wordlist.10000:
aim, ima, mai
arc, rca, car
asp, spa, pas
ate, tea, eat
ips, psi, sip
 
woordenlijst.txt:
ast, sta, tas
een, ene, nee
eer, ere, ree
</pre>
 
=={{header|Rust}}==
<syntaxhighlight lang="rust">use std::collections::BTreeSet;
use std::collections::HashSet;
use std::fs::File;
use std::io::{self, BufRead};
use std::iter::FromIterator;
 
fn load_dictionary(filename: &str) -> std::io::Result<BTreeSet<String>> {
let file = File::open(filename)?;
let mut dict = BTreeSet::new();
for line in io::BufReader::new(file).lines() {
let word = line?;
dict.insert(word);
}
Ok(dict)
}
 
fn find_teacup_words(dict: &BTreeSet<String>) {
let mut teacup_words: Vec<&String> = Vec::new();
let mut found: HashSet<&String> = HashSet::new();
for word in dict {
let len = word.len();
if len < 3 || found.contains(word) {
continue;
}
teacup_words.clear();
let mut is_teacup_word = true;
let mut chars: Vec<char> = word.chars().collect();
for _ in 1..len {
chars.rotate_left(1);
if let Some(w) = dict.get(&String::from_iter(&chars)) {
if !w.eq(word) && !teacup_words.contains(&w) {
teacup_words.push(w);
}
} else {
is_teacup_word = false;
break;
}
}
if !is_teacup_word || teacup_words.is_empty() {
continue;
}
print!("{}", word);
found.insert(word);
for w in &teacup_words {
found.insert(w);
print!(" {}", w);
}
println!();
}
}
 
fn main() {
let args: Vec<String> = std::env::args().collect();
if args.len() != 2 {
eprintln!("Usage: teacup dictionary");
std::process::exit(1);
}
let dict = load_dictionary(&args[1]);
match dict {
Ok(dict) => find_teacup_words(&dict),
Err(error) => eprintln!("Cannot open file {}: {}", &args[1], error),
}
}</syntaxhighlight>
 
{{out}}
With unixdict.txt:
<pre>
apt pta tap
arc rca car
ate tea eat
</pre>
With wordlist.10000:
<pre>
aim ima mai
arc rca car
asp spa pas
ate tea eat
ips psi sip
</pre>
 
=={{header|Swift}}==
<syntaxhighlight lang="swift">import Foundation
 
func loadDictionary(_ path: String) throws -> Set<String> {
let contents = try String(contentsOfFile: path, encoding: String.Encoding.ascii)
return Set<String>(contents.components(separatedBy: "\n").filter{!$0.isEmpty})
}
 
func rotate<T>(_ array: inout [T]) {
guard array.count > 1 else {
return
}
let first = array[0]
array.replaceSubrange(0..<array.count-1, with: array[1...])
array[array.count - 1] = first
}
 
func findTeacupWords(_ dictionary: Set<String>) {
var teacupWords: [String] = []
var found = Set<String>()
for word in dictionary {
if word.count < 3 || found.contains(word) {
continue
}
teacupWords.removeAll()
var isTeacupWord = true
var chars = Array(word)
for _ in 1..<word.count {
rotate(&chars)
let w = String(chars)
if (!dictionary.contains(w)) {
isTeacupWord = false
break
}
if w != word && !teacupWords.contains(w) {
teacupWords.append(w)
}
}
if !isTeacupWord || teacupWords.isEmpty {
continue
}
print(word, terminator: "")
found.insert(word)
for w in teacupWords {
found.insert(w)
print(" \(w)", terminator: "")
}
print()
}
}
 
do {
let dictionary = try loadDictionary("unixdict.txt")
findTeacupWords(dictionary)
} catch {
print(error)
}</syntaxhighlight>
 
{{out}}
<pre>
car arc rca
eat ate tea
pta tap apt
</pre>
 
=={{header|Wren}}==
{{trans|Go}}
{{libheader|Wren-str}}
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">import "io" for File
import "./str" for Str
import "./sort" for Find
 
var readWords = Fn.new { |fileName|
var dict = File.read(fileName).split("\n")
return dict.where { |w| w.count >= 3 }.toList
}
 
var dicts = ["mit10000.txt", "unixdict.txt"]
for (dict in dicts) {
System.print("Using %(dict):\n")
var words = readWords.call(dict)
var n = words.count
var used = {}
for (word in words) {
var outer = false
var variants = [word]
var word2 = word
for (i in 0...word.count-1) {
word2 = Str.lshift(word2)
if (word == word2 || used[word2]) {
outer = true
break
}
var ix = Find.first(words, word2)
if (ix == n || words[ix] != word2) {
outer = true
break
}
variants.add(word2)
}
if (!outer) {
for (variant in variants) used[variant] = true
System.print(variants)
}
}
System.print()
}</syntaxhighlight>
 
{{out}}
<pre>
Using mit10000.txt:
 
[aim, ima, mai]
[arc, rca, car]
[asp, spa, pas]
[ate, tea, eat]
[ips, psi, sip]
 
Using unixdict.txt:
 
[apt, pta, tap]
[arc, rca, car]
[ate, tea, eat]
</pre>
 
=={{header|zkl}}==
<syntaxhighlight lang="zkl">// Limited to ASCII
<lang zkl>// this is limited to the max items a Dictionary can hold
// This is limited to the max items a Dictionary can hold
fcn teacut(wordFile){
words:=File(wordFile).pump(Dictionary().add.fp1(True),"strip");
Line 912 ⟶ 2,057:
foreach word in (words.keys){
rots,w,sz := List(), word, word.len();
if(sz>2 and word.unique().len()>2 and not seen.holds(word)){
do(sz-1){
w=String(w[-1],w[0,-1]); // rotate one character
Line 922 ⟶ 2,067:
}
}
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">println("\nunixdict:"); teacut("unixdict.txt");
println("\nmit_wordlist_10000:"); teacut("mit_wordlist_10000.txt");</langsyntaxhighlight>
{{out}}
<pre>
unixdict:
aaa aaa aaa
apt pta tap
ate eat tea
arc car rca
iii iii iii
 
mit_wordlist_10000:
www www www
asp pas spa
ips psi sip
iii iii iii
ate eat tea
aaa aaa aaa
aim ima mai
arc car rca
xxx xxx xxx
ooo ooo ooo
</pre>
 
{{omit from|6502 Assembly|unixdict.txt is much larger than the CPU's address space.}}
{{omit from|8080 Assembly|See 6502 Assembly.}}
{{omit from|Z80 Assembly|See 6502 Assembly.}}
PureFox
9,482

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/292049...353857"