Teacup rim text: Difference between revisions

m
No edit summary
m (→‎{{header|Wren}}: Minor tidy)
 
(18 intermediate revisions by 11 users not shown)
Line 34:
 
=={{header|11l}}==
<langsyntaxhighlight lang="11l">F rotated(String s)
R s[1..]‘’s[0]
 
Line 59:
print()
 
L.break</langsyntaxhighlight>
 
{{out}}
Line 67:
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">
<lang AWK>
# syntax: GAWK -f TEACUP_RIM_TEXT.AWK UNIXDICT.TXT
#
Line 110 ⟶ 181:
exit(0)
}
</syntaxhighlight>
</lang>
{{out}}
<p>using UNIXDICT.TXT</p>
Line 130 ⟶ 201:
 
=={{header|BaCon}}==
<langsyntaxhighlight lang="bacon">OPTION COLLAPSE TRUE
 
dict$ = LOAD$(DIRNAME$(ME$) & "/unixdict.txt")
Line 147 ⟶ 218:
 
PRINT result$
PRINT "Total words: ", AMOUNT(dict$, NL$), ", and ", AMOUNT(result$, NL$), " are circular."</langsyntaxhighlight>
{{out}}
Using 'unixdict.txt':
Line 165 ⟶ 236:
=={{header|C}}==
{{libheader|GLib}}
<langsyntaxhighlight lang="c">#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
Line 271 ⟶ 342:
g_ptr_array_free(dictionary, TRUE);
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
{{out}}
Line 290 ⟶ 361:
 
=={{header|C++}}==
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <fstream>
#include <iostream>
Line 347 ⟶ 418:
}
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
{{out}}
Line 366 ⟶ 437:
 
=={{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 382 ⟶ 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 389 ⟶ 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 402 ⟶ 473:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 471 ⟶ 542:
fmt.Println()
}
}</langsyntaxhighlight>
 
{{out}}
Line 493 ⟶ 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 523 ⟶ 594:
filter
((1 <) . length)
(groupBy (on (==) fst) (sortBy (comparing fst) (((,) =<< sort) <$> xs)))</langsyntaxhighlight>
{{Out}}
<pre>arc -> car -> rca
Line 534 ⟶ 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, sortOnon)
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) (sortOn 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
| otherwise = [h : rs]
rs = filter (isRotation h) (tail ws)
where
in bool [h : rs] [] ((length h - 1) > length rs)
h = head ws
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) = xs ++<> [x]</langsyntaxhighlight>
{{Out}}
<pre>arc -> rca -> car
Line 570 ⟶ 660:
 
=={{header|J}}==
<syntaxhighlight lang="j"> >@{.@> (#~ (=&#>@{.)@> * 2 < #@>)(</.~ {.@/:~@(|."0 1~ i.@#)L:0)cutLF fread'unixdict.txt'
Definitions, which are developed following the solution
apt
<lang J>
arc
read=: CR -.~ 1!:1@boxopen NB. dang that line end!
ate</syntaxhighlight>
Filter=:(#~`)(`:6)
 
prep=: (;~ /:~);._2
 
gba=: <@:([: ,/ (>@}."1))/.~ 0&{"1
ew=: (>:&# {.)S:_1 Filter
le=: (2 < #@{.)S:_1 Filter
ra=: a: -.~ rotations&>
 
NB. prep was separated for fun, not necessity
teacup=: ra@:le@:ew@:gba
 
rotations=: 3 :0
subset=: 0 = #@:-.
assert. 0 1 -: 'ab'(subset~ , subset)'cabag'
N=. # {. y
for_word. y do.
a=. N ]\ (, (<: N)&{.) word
if. a subset y do. word return. end.
end.
''
)
</lang>
Solution finds "apt", "arc", and "ate".
<lang J>
NB. D includes the ordered anagram
D=: prep read'd:\tmp\dict'
 
NB. transposed samples of the input to teacup
|: ({~ (7 ?@$ #)) D
┌──────────┬────────────┬───────┬──────────┬──────┬────────┬────────┐
│ aaegnprty│ aadeiloprtz│ gmpsuy│ eimnnptuu│ aipst│ agggint│ effoprr│
├──────────┼────────────┼───────┼──────────┼──────┼────────┼────────┤
│pageantry │trapezoidal │gypsum │neptunium │tapis │tagging │proffer │
└──────────┴────────────┴───────┴──────────┴──────┴────────┴────────┘
 
teacup D
┌───┬───┬───┐
│apt│arc│ate│
└───┴───┴───┘
</lang>
The action of the individual verbs shown here along with intermediate pronouns having such descriptive names as to describe the proverbial names demonstrates the construction of teacup.
<lang J>
TEST_DICTIONARY=: 'abc ah ate bac bca blort cab eat ha rat tar tea tra '
TEST=: prep TEST_DICTIONARY
 
] GROUPS_BY_ANAGRAM=: gba TEST
┌───┬──┬───┬─────┬───┐
│abc│ah│ate│blort│rat│
│bac│ha│eat│ │tar│
│bca│ │tea│ │tra│
│cab│ │ │ │ │
└───┴──┴───┴─────┴───┘
] ENOUGH_WORDS=: ew GROUPS_BY_ANAGRAM
┌───┬──┬───┬───┐
│abc│ah│ate│rat│
│bac│ha│eat│tar│
│bca│ │tea│tra│
│cab│ │ │ │
└───┴──┴───┴───┘
] LONG_ENOUGH=: le ENOUGH_WORDS
┌───┬───┬───┐
│abc│ate│rat│
│bac│eat│tar│
│bca│tea│tra│
│cab│ │ │
└───┴───┴───┘
 
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.
] SOLUTION=: ROTATIONS_ACCEPTABLE=: ra LONG_ENOUGH
┌───┬───┐
│abc│ate│
└───┴───┘
</lang>
 
=={{header|Java}}==
{{trans|C++}}
<langsyntaxhighlight lang="java">import java.io.*;
import java.util.*;
 
Line 708 ⟶ 728:
return ch;
}
}</langsyntaxhighlight>
 
{{out}}
Line 730 ⟶ 750:
Reading a local dictionary with the macOS JS for Automation library:
{{Works with|JXA}}
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 887 ⟶ 907:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>arc -> car -> rca
Line 898 ⟶ 918:
Reading a local dictionary with the macOS JS for Automation library:
{{Works with|JXA}}
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 1,037 ⟶ 1,057:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>arc -> rca -> car
Line 1,044 ⟶ 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 1,062 ⟶ 1,129:
foreach(println, getteawords("https://www.mit.edu/~ecprice/wordlist.10000"))
</langsyntaxhighlight>{{out}}
<pre>
["aim", "ima", "mai"]
Line 1,076 ⟶ 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 1,105 ⟶ 1,172:
.filter(key => collection[key].length > 1)
.forEach(key => console.log("%s", collection[key].join(", ")));
</syntaxhighlight>
</lang>
<pre>
apt, pta, tap
Line 1,111 ⟶ 1,178:
ate, eat, tea
</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">ClearAll[Teacuppable]
TeacuppableHelper[set_List] := Module[{f, s},
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}}==
 
<syntaxhighlight lang="nim">import sequtils, sets, sugar
 
let words = collect(initHashSet, for word in "unixdict.txt".lines: {word})
 
proc rotate(s: var string) =
let first = s[0]
for i in 1..s.high: s[i - 1] = s[i]
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}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use feature 'say';
Line 1,148 ⟶ 1,278:
}
 
say join ', ', uniqstr @$_ for sort @teacups;</langsyntaxhighlight>
{{out}}
<pre>ARC, RCA, CAR
Line 1,158 ⟶ 1,288:
=={{header|Phix}}==
Filters anagram lists
<!--<syntaxhighlight lang="phix">-->
<lang Phix>procedure filter(sequence anagrams)
<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>
sequence used = repeat(false,length(anagrams))
<span style="color: #000080;font-style:italic;">-- anagrams is a (small) set of words that are all anagrams of each other
for i=1 to length(anagrams) do
-- for example: {"angel","angle","galen","glean","lange"}
if not used[i] then
-- print any set(s) for which every rotation is also present (marking as
used[i] = true
-- you go to prevent the same stringset appearing with each word =being anagrams[i]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>
sequence res = {word}
<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>
for r=2 to length(word) do
<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>
word = word[2..$]&word[1]
<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>
integer k = find(word,anagrams)
<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>
if k=0 then res = {} exit end if
<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>
if not find(word,res) then
<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>
res = append(res,word)
<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>
end if
<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>
used[k] = true
<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>
end for
<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>
if length(res) then ?res end if
<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>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<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>
end procedure
<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>
procedure teacup(string filename, integer minlen=3, bool allow_mono=false)
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
sequence words = {}, anagrams = {}, last="", letters
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
object word
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
 
printf(1,"using %s",filename)
<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>
integer fn = open(filename,"r")
<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>
if fn=-1 then crash(filename&" not found") end if
<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>
while 1 do
<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>
word = lower(trim(gets(fn)))
<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>
if atom(word) then exit end if
<span style="color: #004080;">object</span> <span style="color: #000000;">word</span>
if length(word)>=minlen then
letters = sort(word)
<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>
words = append(words, {letters, word})
<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>
end if
<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>
end while
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
close(fn)
<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>
printf(1,", %d words read\n",length(words))
<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>
if length(words)!=0 then
<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>
words = sort(words)
<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>
for i=1 to length(words) do
<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>
{letters,word} = words[i]
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
if letters=last then
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
anagrams = append(anagrams,word)
<span style="color: #7060A8;">close</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fn</span><span style="color: #0000FF;">)</span>
else
<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>
if allow_mono or length(anagrams)>=length(last) then
<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>
filter(anagrams)
<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>
end if
<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>
last = letters
<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>
anagrams = {word}
<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>
end if
<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>
end for
<span style="color: #008080;">else</span>
if allow_mono or length(anagrams)>=length(last) then
<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>
filter(anagrams)
<span style="color: #000000;">filter_set</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end if
<span style="color: #000000;">last</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">letters</span>
end procedure
<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>
teacup(join_path({"demo","unixdict.txt"}))
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
-- These match output from other entries:
<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>
--teacup(join_path({"demo","unixdict.txt"}),allow_mono:=true)
<span style="color: #000000;">filter_set</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span>
--teacup(join_path({"demo","rosetta","mit.wordlist.10000.txt"}))
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
--teacup(join_path({"demo","rosetta","words.txt"}),4,true)
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
-- Note that allow_mono is needed to display eg {"agag","gaga"}</lang>
<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>
Line 1,231 ⟶ 1,370:
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de rotw (W)
(let W (chop W)
(unless (or (apply = W) (not (cddr W)))
Line 1,261 ⟶ 1,400:
Lst )
Lst ) ) )
Words ) )</langsyntaxhighlight>
{{out}}
<pre>
Line 1,272 ⟶ 1,411:
 
=={{header|PureBasic}}==
<langsyntaxhighlight PureBasiclang="purebasic">DataSection
dname:
Data.s "./Data/unixdict.txt"
Line 1,302 ⟶ 1,441:
bset="" : res="" : cw=0
Read.s dn
Wend</langsyntaxhighlight>
{{out}}
<pre>apt pta tap
Line 1,319 ⟶ 1,458:
===Functional===
Composing generic functions, and considering only anagram groups.
<langsyntaxhighlight lang="python">'''Teacup rim text'''
 
from itertools import chain, groupby
Line 1,516 ⟶ 1,655:
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>arc -> rca -> car
Line 1,533 ⟶ 1,672:
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" perl6line>my %*SUB-MAIN-OPTS = :named-anywhere;
 
unit sub MAIN ( $dict = 'unixdict.txt', :$min-chars = 3, :$mono = False );
Line 1,565 ⟶ 1,704:
}
 
say .unique.join(", ") for sort @teacups;</langsyntaxhighlight>
{{out|Defaults}}
Command line: <tt>raku teacup.p6</tt>
Line 1,620 ⟶ 1,759:
 
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 1,650 ⟶ 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 1,663 ⟶ 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}}==
<langsyntaxhighlight lang="rust">use std::collections::BTreeSet;
use std::collections::HashSet;
use std::fs::File;
Line 1,728 ⟶ 1,905:
Err(error) => eprintln!("Cannot open file {}: {}", &args[1], error),
}
}</langsyntaxhighlight>
 
{{out}}
Line 1,747 ⟶ 1,924:
 
=={{header|Swift}}==
<langsyntaxhighlight lang="swift">import Foundation
 
func loadDictionary(_ path: String) throws -> Set<String> {
Line 1,802 ⟶ 1,979:
} catch {
print(error)
}</langsyntaxhighlight>
 
{{out}}
Line 1,815 ⟶ 1,992:
{{libheader|Wren-str}}
{{libheader|Wren-sort}}
<langsyntaxhighlight ecmascriptlang="wren">import "io" for File
import "./str" for Str
import "./sort" for Find
 
var readWords = Fn.new { |fileName|
Line 1,853 ⟶ 2,030:
}
System.print()
}</langsyntaxhighlight>
 
{{out}}
Line 1,873 ⟶ 2,050:
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">// Limited to ASCII
// This is limited to the max items a Dictionary can hold
fcn teacut(wordFile){
Line 1,890 ⟶ 2,067:
}
}
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">println("\nunixdict:"); teacut("unixdict.txt");
println("\nmit_wordlist_10000:"); teacut("mit_wordlist_10000.txt");</langsyntaxhighlight>
{{out}}
<pre>
Line 1,907 ⟶ 2,084:
arc car rca
</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.}}
9,476

edits