Teacup rim text: Difference between revisions
m →{{header|REXX}}: added/changed some comments. |
→{{header|Go}}: Updated to exclude duplicates etc. |
||
Line 74: | Line 74: | ||
words := readWords("mit_10000.txt") // using local copy |
words := readWords("mit_10000.txt") // using local copy |
||
n := len(words) |
n := len(words) |
||
used := make(map[string]bool) |
|||
outer: |
outer: |
||
for _, word := range words { |
for _, word := range words { |
||
Line 81: | Line 82: | ||
rotate(runes) |
rotate(runes) |
||
word2 := string(runes) |
word2 := string(runes) |
||
if word == word2 || used[word2] { |
|||
continue outer |
|||
} |
|||
ix := sort.SearchStrings(words, word2) |
ix := sort.SearchStrings(words, word2) |
||
if ix == n || words[ix] != word2 { |
if ix == n || words[ix] != word2 { |
||
Line 86: | Line 90: | ||
} |
} |
||
variants = append(variants, word2) |
variants = append(variants, word2) |
||
} |
|||
for _, variant := range variants { |
|||
used[variant] = true |
|||
} |
} |
||
fmt.Println(variants) |
fmt.Println(variants) |
||
Line 93: | Line 100: | ||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
[aaa aaa aaa] |
|||
[aim ima mai] |
[aim ima mai] |
||
[arc rca car] |
[arc rca car] |
||
[asp spa pas] |
[asp spa pas] |
||
[ate tea eat] |
[ate tea eat] |
||
[car arc rca] |
|||
[eat ate tea] |
|||
[iii iii iii] |
|||
[ima mai aim] |
|||
[ips psi sip] |
[ips psi sip] |
||
[mai aim ima] |
|||
[ooo ooo ooo] |
|||
[pas asp spa] |
|||
[psi sip ips] |
|||
[rca car arc] |
|||
[sip ips psi] |
|||
[spa pas asp] |
|||
[tea eat ate] |
|||
[www www www] |
|||
[xxx xxx xxx] |
|||
</pre> |
</pre> |
||
Revision as of 08:06, 5 August 2019
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".
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, use the MIT 10000 word list located at https://www.mit.edu/~ecprice/wordlist.10000
So here's the task: from a web accessible or locally accessible word source, iterate through each word of length 3 or more. With each word, peel off the first letter and put it at the end. Check if the word exists. If it does, keep going with the next letter, repeating the process for as many letters as there are minus one. If all of the words exist store the original word. List each word that survives the filtration process along with all its variants. Having listed a set, for example [ate tea eat], resist displaying permutations of that set, e.g. [eat tea ate] etc.
Factor
<lang factor>USING: fry hash-sets http.client kernel math prettyprint sequences sequences.extras sets sorting splitting ;
"https://www.mit.edu/~ecprice/wordlist.10000" http-get nip "\n" split [ length 2 > ] filter [ [ all-rotations ] map ] [ >hash-set ] bi '[ [ _ in? ] all? ] filter [ natural-sort ] map members .</lang>
- Output:
{ { "aaa" "aaa" "aaa" } { "aim" "ima" "mai" } { "arc" "car" "rca" } { "asp" "pas" "spa" } { "ate" "eat" "tea" } { "iii" "iii" "iii" } { "ips" "psi" "sip" } { "ooo" "ooo" "ooo" } { "www" "www" "www" } { "xxx" "xxx" "xxx" } }
Go
<lang go>package main
import (
"bufio" "fmt" "log" "os" "sort" "strings"
)
func check(err error) {
if err != nil { log.Fatal(err) }
}
func readWords(fileName string) []string {
file, err := os.Open(fileName) check(err) defer file.Close() var words []string scanner := bufio.NewScanner(file) for scanner.Scan() { word := strings.ToLower(strings.TrimSpace(scanner.Text())) if len(word) >= 3 { words = append(words, word) } } check(scanner.Err()) return words
}
func rotate(runes []rune) {
first := runes[0] copy(runes, runes[1:]) runes[len(runes)-1] = first
}
func main() {
words := readWords("mit_10000.txt") // using local copy n := len(words) used := make(map[string]bool)
outer:
for _, word := range words { runes := []rune(word) variants := []string{word} for i := 0; i < len(runes)-1; i++ { rotate(runes) word2 := string(runes) if word == word2 || used[word2] { continue outer } ix := sort.SearchStrings(words, word2) if ix == n || words[ix] != word2 { continue outer } variants = append(variants, word2) } for _, variant := range variants { used[variant] = true } fmt.Println(variants) }
}</lang>
- Output:
[aim ima mai] [arc rca car] [asp spa pas] [ate tea eat] [ips psi sip]
Haskell
Circular words of more than 2 characters in a local copy of unixdict.txt <lang haskell>import Control.Applicative (liftA2) import qualified Data.Set as S
main :: IO () main = readFile "unixdict.txt" >>= (print . circularWords . lines)
circularWords :: [String] -> [String] circularWords ws =
let lexicon = S.fromList ws in filter (isCircular lexicon) ws
isCircular :: S.Set String -> String -> Bool isCircular lex w =
2 < length w && all (`S.member` lex) (rotations w)
rotations :: [a] -> a rotations = liftA2 fmap rotated (enumFromTo 0 . pred . length)
rotated :: [a] -> Int -> [a] rotated [] _ = [] rotated xs n = zipWith const (drop n (cycle xs)) xs</lang>
- Output:
["aaa","apt","arc","ate","car","eat","iii","pta","rca","tap","tea"]
JavaScript
Reading a local dictionary with a macOS JS for Automation library:
<lang javascript>(() => {
'use strict';
// main :: IO () const main = () => showLog( circularWords( lines(readFile('~/unixdict.txt')) ) );
// circularWords :: [String] -> [String] const circularWords = ws => ws.filter(isCircular(new Set(ws)), ws);
// isCircular :: Set String -> String -> Bool const isCircular = lexicon => w => { const iLast = w.length - 1; return 1 < iLast && until( ([i, bln, s]) => iLast < i || !bln, ([i, bln, s]) => [1 + i, lexicon.has(s), rotated(s)], [0, true, w] )[1]; }
// MAC OS JS FOR AUTOMATION ---------------------------
// readFile :: FilePath -> IO String const readFile = fp => { const e = $(), uw = ObjC.unwrap, s = uw( $.NSString.stringWithContentsOfFileEncodingError( $(fp) .stringByStandardizingPath, $.NSUTF8StringEncoding, e ) ); return undefined !== s ? ( s ) : uw(e.localizedDescription); };
// GENERIC FUNCTIONS ----------------------------------
// lines :: String -> [String] const lines = s => s.split(/[\r\n]/);
// rotated :: String -> String const rotated = xs => xs.slice(1) + xs[0];
// showLog :: a -> IO () const showLog = (...args) => console.log( args .map(JSON.stringify) .join(' -> ') );
// until :: (a -> Bool) -> (a -> a) -> a -> a const until = (p, f, x) => { let v = x; while (!p(v)) v = f(v); return v; };
// MAIN --- return main();
})();</lang>
- Output:
["aaa","apt","arc","ate","car","eat","iii","pta","rca","tap","tea"]
Julia
Using the MIT 10000 word list, and excluding words of less than three letters, to reduce output length. <lang julia>using HTTP
function getwords()
req = HTTP.request("GET", "https://www.mit.edu/~ecprice/wordlist.10000") Dict{String, Int}((string(x), 1) for x in split(String(req.body), r"\s+"))
end
rotate(s, n) = String(circshift(Vector{UInt8}(s), n))
isliketea(w, d) = (n = length(w); n > 2 && all(i -> haskey(d, rotate(w, i)), 1:n-1))
function getteawords()
wordlistdict = getwords() for word in collect(keys(wordlistdict)) if isliketea(word, wordlistdict) println(word, ": ", [rotate(word, i) for i in 1:length(word)-1]) end end
end
getteawords()
</lang>
- Output:
pas: ["spa", "asp"] xxx: ["xxx", "xxx"] iii: ["iii", "iii"] asp: ["pas", "spa"] tea: ["ate", "eat"] spa: ["asp", "pas"] ate: ["eat", "tea"] aim: ["mai", "ima"] aaa: ["aaa", "aaa"] car: ["rca", "arc"] ooo: ["ooo", "ooo"] sip: ["psi", "ips"] arc: ["car", "rca"] ips: ["sip", "psi"] www: ["www", "www"] mai: ["ima", "aim"] rca: ["arc", "car"] eat: ["tea", "ate"] psi: ["ips", "sip"] ima: ["aim", "mai"]
Lychen
Lychen is V8 JavaScript wrapped in C#, exposing C# into JavaScript.
Using https://www.mit.edu/~ecprice/wordlist.10000 as per the Julia example.
<lang javascript> const wc = new CS.System.Net.WebClient(); const lines = wc.DownloadString("https://www.mit.edu/~ecprice/wordlist.10000"); const words = lines.split(/\n/g); const collection = {}; words.filter(word => word.length > 2).forEach(word => {
let allok = true; let newword = word; for (let i = 0; i < word.length - 1; i++) { newword = newword.substr(1) + newword.substr(0, 1); if (!words.includes(newword)) { allok = false; break; } } if (allok) { const key = word.split("").sort().join(""); if (!collection[key]) { collection[key] = [word]; } else { if (!collection[key].includes(word)) { collection[key].push(word); } } }
}); Object.keys(collection) .filter(key => collection[key].length > 1) .forEach(key => console.log("%s", collection[key].join(", "))); </lang>
aim, ima, mai arc, car, rca asp, pas, spa ate, eat, tea ips, psi, sip
Perl 6
Using the same file as the reference implementation (Lychen), downloaded to a local file to give my connection a break.
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. Most of them are anyway, as this list seems to be full of abbreviations, acronyms and initialisms. Ah well. I didn't choose the word list.
<lang perl6>my %words; './words.txt'.IO.slurp.words.map: { %words{.uc.comb.sort.join}.push: $_.uc };
for %words.keys { %words{$_}:delete if %words{$_}.elems < 2 or $_.chars < 3 };
my @teacups; my %seen;
for %words.values -> @these {
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 = (); last } } if @print.elems { @teacups.push: @print; %seen{$_}++ for @print; } }
}
say .unique.join(", ") if .elems for sort @teacups;</lang>
- Output:
AAE, AEA, EAA AAF, AFA, FAA AAH, AHA, HAA AAM, AMA, MAA AAS, ASA, SAA ABB, BBA, BAB ABD, BDA, DAB ABI, BIA, IAB ABL, BLA, LAB ABM, BMA, MAB ABR, BRA, RAB ABS, BSA, SAB ABV, BVA, VAB ACC, CCA, CAC ACD, CDA, DAC ACF, CFA, FAC ACH, CHA, HAC ACM, CMA, MAC ACP, CPA, PAC ACS, CSA, SAC ACT, CTA, TAC ACV, CVA, VAC ACW, CWA, WAC ADAD, DADA ADAR, DARA, ARAD, RADA ADB, DBA, BAD ADC, DCA, CAD ADD, DDA, DAD ADE, DEA, EAD ADF, DFA, FAD ADI, DIA, IAD ADM, DMA, MAD ADN, DNA, NAD ADO, DOA, OAD ADP, DPA, PAD ADS, DSA, SAD AEC, ECA, CAE AER, ERA, RAE AES, ESA, SAE AET, ETA, TAE AFC, FCA, CAF AFI, FIA, IAF AFL, FLA, LAF AFR, FRA, RAF AGAG, GAGA AGC, GCA, CAG AGD, GDA, DAG AGH, GHA, HAG AGR, GRA, RAG AGS, GSA, SAG AGT, GTA, TAG AHI, HIA, IAH AIC, ICA, CAI AIL, ILA, LAI AIM, IMA, MAI AIR, IRA, RAI AIS, ISA, SAI AIT, ITA, TAI AKE, KEA, EAK AKH, KHA, HAK AKO, KOA, OAK ALC, LCA, CAL ALE, LEA, EAL ALG, LGA, GAL ALI, LIA, IAL ALIT, LITA, ITAL, TALI ALT, LTA, TAL AMAN, MANA, ANAM, NAMA AMAR, MARA, ARAM, RAMA AMB, MBA, BAM AMC, MCA, CAM AME, MEA, EAM AMEL, MELA, ELAM, LAME AMEN, MENA, ENAM, NAME AMI, MIA, IAM AMO, MOA, OAM AMOR, MORA, ORAM, RAMO AMP, MPA, PAM AMR, MRA, RAM AMS, MSA, SAM AMT, MTA, TAM AMU, MUA, UAM AMY, MYA, YAM ANAN, NANA ANC, NCA, CAN AND, NDA, DAN ANE, NEA, EAN ANG, NGA, GAN ANH, NHA, HAN ANI, NIA, IAN ANIL, NILA, ILAN, LANI ANS, NSA, SAN ANY, NYA, YAN AOB, OBA, BAO AOL, OLA, LAO AOP, OPA, PAO AOR, ORA, RAO AOS, OSA, SAO APC, PCA, CAP APG, PGA, GAP APH, PHA, HAP APL, PLA, LAP APM, PMA, MAP APO, POA, OAP APP, PPA, PAP APR, PRA, RAP APS, PSA, SAP APT, PTA, TAP ARAR, RARA ARAS, RASA, ASAR, SARA ARC, RCA, CAR ARD, RDA, DAR ARE, REA, EAR ARF, RFA, FAR ARIS, RISA, ISAR, SARI ARM, RMA, MAR ARN, RNA, NAR ARO, ROA, OAR ARS, RSA, SAR ART, RTA, TAR ARU, RUA, UAR ARY, RYA, YAR ASB, SBA, BAS ASC, SCA, CAS ASE, SEA, EAS ASEL, SELA, ELAS, LASE ASER, SERA, ERAS, RASE ASH, SHA, HAS ASI, SIA, IAS ASK, SKA, KAS ASM, SMA, MAS ASN, SNA, NAS ASP, SPA, PAS ASR, SRA, RAS ASS, SSA, SAS AST, STA, TAS ASW, SWA, WAS ATB, TBA, BAT ATC, TCA, CAT ATE, TEA, EAT ATH, THA, HAT ATM, TMA, MAT ATO, TOA, OAT ATR, TRA, RAT ATV, TVA, VAT AUC, UCA, CAU AUD, UDA, DAU AUL, ULA, LAU AUM, UMA, MAU AUN, UNA, NAU AUS, USA, SAU AVG, VGA, GAV AYH, YHA, HAY AYM, YMA, MAY BCR, CRB, RBC BCS, CSB, SBC BDC, DCB, CBD BDT, DTB, TBD BEC, ECB, CBE BED, EDB, DBE BER, ERB, RBE BES, ESB, SBE BID, IDB, DBI BLL, LLB, LBL BLO, LOB, OBL BMG, MGB, GBM BMI, MIB, IBM BMP, MPB, PBM BOM, OMB, MBO BOO, OOB, OBO BOT, OTB, TBO BRC, RCB, CBR BSC, SCB, CBS BSD, SDB, DBS BSO, SOB, OBS BSS, SSB, SBS BST, STB, TBS BSW, SWB, WBS BUS, USB, SBU BYO, YOB, OBY CCD, CDC, DCC CCF, CFC, FCC CCI, CIC, ICC CCM, CMC, MCC CCP, CPC, PCC CCR, CRC, RCC CCS, CSC, SCC CCT, CTC, TCC CCW, CWC, WCC CDI, DIC, ICD CDN, DNC, NCD CDO, DOC, OCD CDS, DSC, SCD CDU, DUC, UCD CED, EDC, DCE CEE, EEC, ECE CEN, ENC, NCE CFE, FEC, ECF CFM, FMC, MCF CFP, FPC, PCF CFR, FRC, RCF CGM, GMC, MCG CHI, HIC, ICH CHM, HMC, MCH CHO, HOC, OCH CHS, HSC, SCH CID, IDC, DCI CIM, IMC, MCI CIO, IOC, OCI CIP, IPC, PCI CIR, IRC, RCI CIS, ISC, SCI CLE, LEC, ECL CLR, LRC, RCL CLU, LUC, UCL CLY, LYC, YCL CMD, MDC, DCM CMI, MIC, ICM CML, MLC, LCM CMS, MSC, SCM CMT, MTC, TCM CNM, NMC, MCN CNR, NRC, RCN CON, ONC, NCO COP, OPC, PCO COR, ORC, RCO COS, OSC, SCO CPI, PIC, ICP CPL, PLC, LCP CPM, PMC, MCP CPR, PRC, RCP CPS, PSC, SCP CRE, REC, ECR CRL, RLC, LCR CRO, ROC, OCR CRS, RSC, SCR CRT, RTC, TCR CRU, RUC, UCR CSE, SEC, ECS CSF, SFC, FCS CSI, SIC, ICS CSL, SLC, LCS CSM, SMC, MCS CSO, SOC, OCS CSP, SPC, PCS CSR, SRC, RCS CSS, SSC, SCS CST, STC, TCS CTD, TDC, DCT CTE, TEC, ECT CTF, TFC, FCT CTG, TGC, GCT CTO, TOC, OCT CTT, TTC, TCT CUE, UEC, ECU CUR, URC, RCU DDE, DED, EDD DDS, DSD, SDD DDT, DTD, TDD DEN, END, NDE DENI, ENID, NIDE, IDEN DEP, EPD, PDE DET, ETD, TDE DFE, FED, EDF DFI, FID, IDF DIM, IMD, MDI DIN, IND, NDI DIT, ITD, TDI DIU, IUD, UDI DLI, LID, IDL DLL, LLD, LDL DLS, LSD, SDL DME, MED, EDM DMI, MID, IDM DMS, MSD, SDM DMT, MTD, TDM DMV, MVD, VDM DNI, NID, IDN DOE, OED, EDO DOI, OID, IDO DOLI, OLID, LIDO, IDOL DOS, OSD, SDO DOU, OUD, UDO DPE, PED, EDP DPI, PID, IDP DPP, PPD, PDP DRU, RUD, UDR DSE, SED, EDS DSI, SID, IDS DSM, SMD, MDS DSO, SOD, ODS DSP, SPD, PDS DSR, SRD, RDS DSS, SSD, SDS DSU, SUD, UDS DTE, TED, EDT DTP, TPD, PDT DYE, YED, EDY DZO, ZOD, ODZ EEK, EKE, KEE EEL, ELE, LEE EEM, EME, MEE EEN, ENE, NEE EER, ERE, REE EFT, FTE, TEF EGOR, GORE, OREG, REGO EGP, GPE, PEG EHF, HFE, FEH EHR, HRE, REH EIN, INE, NEI EIR, IRE, REI EIS, ISE, SEI ELM, LME, MEL ELS, LSE, SEL EMM, MME, MEM EMP, MPE, PEM EMR, MRE, REM EMS, MSE, SEM ENOL, NOLE, OLEN, LENO ENS, NSE, SEN EOM, OME, MEO EON, ONE, NEO EPP, PPE, PEP EPS, PSE, SEP ERF, RFE, FER ERI, RIE, IER ERL, RLE, LER ERS, RSE, SER ERT, RTE, TER ERY, RYE, YER ESH, SHE, HES ESL, SLE, LES ESM, SME, MES ESO, SOE, OES ESOP, SOPE, OPES, PESO ESP, SPE, PES ESS, SSE, SES EST, STE, TES ETH, THE, HET ETS, TSE, SET ETY, TYE, YET EYN, YNE, NEY FMS, MSF, SFM FOO, OOF, OFO FOS, OSF, SFO FOU, OUF, UFO FRI, RIF, IFR FRT, RTF, TFR FSH, SHF, HFS FSU, SUF, UFS GON, ONG, NGO GPI, PIG, IGP GPS, PSG, SGP GTO, TOG, OGT HIN, INH, NHI HIP, IPH, PHI HIS, ISH, SHI HMP, MPH, PHM HMS, MSH, SHM HMT, MTH, THM HOO, OOH, OHO HOP, OPH, PHO HPO, POH, OHP HRS, RSH, SHR HSU, SUH, UHS HTS, TSH, SHT HUS, USH, SHU ILO, LOI, OIL ILS, LSI, SIL IMS, MSI, SIM IMT, MTI, TIM IOR, ORI, RIO IPL, PLI, LIP IPR, PRI, RIP IPS, PSI, SIP IPT, PTI, TIP IRM, RMI, MIR IRO, ROI, OIR ISIS, SISI ISM, SMI, MIS ISS, SSI, SIS IST, STI, TIS ITO, TOI, OIT ITS, TSI, SIT ITU, TUI, UIT IXM, XMI, MIX KTS, TSK, SKT KUS, USK, SKU LLP, LPL, PLL LOT, OTL, TLO LPP, PPL, PLP LPS, PSL, SLP LRS, RSL, SLR LSM, SML, MLS LSP, SPL, PLS MMS, MSM, SMM MMU, MUM, UMM MOP, OPM, PMO MORO, OROM, ROMO, OMOR MOT, OTM, TMO MPS, PSM, SMP MRS, RSM, SMR MSN, SNM, NMS MSO, SOM, OMS MSR, SRM, RMS MSS, SSM, SMS MST, STM, TMS MTP, TPM, PMT MTS, TSM, SMT MTU, TUM, UMT MVO, VOM, OMV NOO, OON, ONO NPP, PPN, PNP NRO, RON, ONR NSO, SON, ONS NSU, SUN, UNS NTO, TON, ONT NUS, USN, SNU OOS, OSO, SOO OOT, OTO, TOO OPS, PSO, SOP OPT, PTO, TOP OSS, SSO, SOS OTR, TRO, ROT OTS, TSO, SOT OUS, USO, SOU PPS, PSP, SPP PSR, SRP, RPS PSS, SSP, SPS PST, STP, TPS PSU, SUP, UPS PTS, TSP, SPT PTT, TTP, TPT PUS, USP, SPU RSS, SSR, SRS RSU, SUR, URS RSV, SVR, VRS SST, STS, TSS SSU, SUS, USS YSO, SOY, OYS
Python
Functional
Composing generic functions, and taking only circular words of more than two characters.
<lang python>Teacup rim text
from os.path import expanduser
- main :: IO ()
def main():
Circular words of more than two characters in a local copy of unixdict.txt print( circularWords( lines(readFile('~/unixdict.txt')) ) )
- circularWords :: [String] -> [String]
def circularWords(ws):
The subset of those words in the given list which are circular. lexicon = set(ws) return list(filter(isCircular(lexicon), ws))
- isCircular :: Set String -> String -> Bool
def isCircular(lexicon):
True if the given word contains more than two characters, and all of its rotations are found in the lexicon. def go(w): iLast = len(w) - 1
def p(tpl): (i, bln, _) = tpl return iLast < i or (not bln)
def f(tpl): (i, _, x) = tpl return (1 + i, x in lexicon, rotated(x))
return 1 < iLast and until(p)(f)( (0, True, w) )[1]
return lambda s: go(s)
- GENERIC -------------------------------------------------
- lines :: String -> [String]
def lines(s):
A list of strings, (containing no newline characters) derived from a single new-line delimited string. return s.splitlines()
- 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()
- rotated :: String -> String
def rotated(s):
A list rotated 1 character to the right. return s[1:] + s[0]
- until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
The result of repeatedly applying f until p holds. The initial seed value is x. def go(f, x): v = x while not p(v): v = f(v) return v return lambda f: lambda x: go(f, x)
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
['aaa', 'apt', 'arc', 'ate', 'car', 'eat', 'iii', 'pta', 'rca', 'tap', 'tea']
REXX
All words that contained non─letter (Latin) characters (periods, decimal digits, minus signs, underbars, or embedded blanks) weren't considered as candidates for circular words.
The dictionary wasn't assumed to be sorted in any way. <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.*/ if L==| L=="," then L= 3 /* " " " " " " */
- = 0 /*number of words in dictionary, Len>L.*/
@.= /*stemmed array of non─duplicated words*/
do r=0 while lines(iFID)\==0 /*read all lines (words) in dictionary.*/ z= space( linein(iFID) ) /*obtain get a word from the dictionary*/ if length(z)<L | @.z\== then iterate /*length must be L or more, no dups.*/ if \datatype(z, 'M') then iterate /*Word contains non-letters? Then skip*/ @.z = z /*assign a word from the dictionary. */ #= # + 1; $.#= z /*bump word count; append word to list.*/ end /*r*/ /* [↑] dictionary need not be sorted. */
say "There're " r ' entries in the dictionary (of all types): ' iFID say "There're " # ' words in the dictionary of at least length ' L say cw= 0 /*the number of circular words (so far)*/
do j=1 for #; x= $.j; y= x /*obtain the Jth word in the list. */ if x== then iterate /*if a null, don't show variants. */ yy= y /*the start of a list of the variants. */ do k=1 for length(x)-1 /*"circulate" the litters in the word. */ y= substr(y, 2)left(y, 1) /*add the left letter to the right end.*/ if @.y== then iterate j /*if not a word, then skip this word. */ yy= yy',' y /*append to the list of the variants. */ if y\==x then @.y= /*nullify word to suppress permutations*/ end /*k*/ /* [↓] ··· except for monolithic words.*/ cw= cw + 1 /*bump counter of circular words found.*/ say 'circular word: ' yy /*display a circular word to the term. */ end /*j*/
say say cw ' circular words were found.' /*stick a fork in it, we're all done. */</lang>
- output when using the default inputs:
There're 10000 entries in the dictionary (of all types): wordlist.10k There're 9578 words in the dictionary of at least length 3 circular word: aaa, aaa, aaa circular word: aim, ima, mai circular word: arc, rca, car circular word: asp, spa, pas circular word: ate, tea, eat circular word: iii, iii, iii circular word: ips, psi, sip circular word: ooo, ooo, ooo circular word: www, www, www circular word: xxx, xxx, xxx 10 circular words were found.
zkl
<lang zkl>// this is limited to the max items a Dictionary can hold words:=File("mit_wordlist_10000.txt").pump(Dictionary().add.fp1(True),"strip"); seen :=Dictionary(); foreach word in (words.keys){
rots,w,sz := List(), word, word.len(); if(sz>2 and not seen.holds(word)){ do(sz-1){
w=String(w[-1],w[0,-1]); // rotate one character if(not words.holds(w)) continue(2); // not a word, do next word rots.append(w); // I'd like to see all the rotations
} println(rots.append(word).sort().concat(" ")); rots.pump(seen.add.fp1(True)); // we've seen these rotations }
}</lang>
- Output:
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