Alternade words: Difference between revisions
Walterpachl (talk | contribs) m (REXX Version 2 marked as such) |
m (→{{header|REXX}}: shortened the program, added wording to the REXX section header.) |
||
Line 969: | Line 969: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
=== |
===version 1=== |
||
This REXX version doesn't care what order the words in the dictionary are in, nor does it care what |
This REXX version doesn't care what order the words in the dictionary are in, nor does it care what |
||
<br>case (lower/upper/mixed) the words are in, the search is caseless. |
<br>case (lower/upper/mixed) the words are in, the search for alternades is caseless. |
||
It also allows the minimum length to be specified on the command line (CL) as well as the dictionary file identifier. |
|||
<lang rexx>/*REXX program finds all the caseless alternade words (within an identified dictionary).*/ |
<lang rexx>/*REXX program finds all the caseless alternade words (within an identified dictionary).*/ |
||
parse arg minL iFID . /*obtain optional arguments from the CL*/ |
parse arg minL iFID . /*obtain optional arguments from the CL*/ |
||
if minL=='' |minL=="," |
if minL=='' | minL=="," then minL= 6 /*Not specified? Then use the default.*/ |
||
if iFID=='' |iFID=="," |
if iFID=='' | iFID=="," then iFID='unixdict.txt' /* " " " " " " */ |
||
⚫ | |||
@.= /*default value of any dictionary word.*/ |
@.= /*default value of any dictionary word.*/ |
||
do #=1 while lines(iFID)\==0 /*read each word in the file (word=X).*/ |
|||
x= strip( linein( iFID) ); xu= x /*pick off a word from the input line. */ |
|||
upper xu; @.xu= .; $.#= x /*save semaphore and lowercase version.*/ |
|||
end /*while*/ /* [↑] semaphore name is uppercased. */ |
|||
end /*recs*/ |
|||
nads= 0 /*count of the alternade words found. */ |
nads= 0 /*count of the alternade words found. */ |
||
say copies('─', 30) |
say copies('─', 30) # 'usable words in the dictionary file: ' iFID |
||
say |
say |
||
do j=1 for #-1; L= length($.j) /*process all the words that were found*/ |
|||
if L<minL then iterate /*Is word too short? Then ignore it. */ |
|||
od=; ev= /*initialize 2 parts of alternade word.*/ |
|||
do k=1 for L; |
do k=1 for L; _= substr($.j, k, 1) /*build the " " " " " */ |
||
if k//2 then od= od || |
if k//2 then od= od || _ /* " " odd part " " " */ |
||
else ev= ev || |
else ev= ev || _ /* " " even " " " " */ |
||
end /*k*/ |
end /*k*/ |
||
parse upper value od ev with odU evU /*obtain the uppercase alternade parts.*/ |
|||
if @.odU=='' | @.evU=='' then iterate /*either parts of alternade not extant?*/ |
|||
⚫ | |||
if @.odU=='' | @.evU=='' then iterate /*both parts of the alternade extant? */ |
|||
say left($.j, 20) left(od, 10) left(ev, 10) /*indent a bit.*/ |
|||
end /*j*/ |
|||
end /*j*/ |
|||
say /*stick a fork in it, we're all done. */ |
say /*stick a fork in it, we're all done. */ |
||
say nads ' alternade words found with a minimum length of ' minL</lang> |
say nads ' alternade words found with a minimum length of ' minL</lang> |
||
Line 1,176: | Line 1,175: | ||
57 truant tun rat |
57 truant tun rat |
||
58 twirly til wry</pre> |
58 twirly til wry</pre> |
||
=={{header|Ring}}== |
=={{header|Ring}}== |
Revision as of 21:46, 1 December 2020
An alternade is a word whose alternating letters themselves form two words. For example, the word lounge contains the word lug (lounge) and the word one (lounge). For a word to be an alternade, all its letters must be used. The two words that form an alternade don't need to be the same length; for example, the word board is an alternade made up of the words bad (board) and or (board).
- Task
Print out every alternade in unixdict.txt whose length is 6 or greater, also showing both the words that make up the alternade.
APL
<lang APL>alternade←{
⍺←6 parts←{(⊂k/⍵),⊂(~k←2|⍳≢⍵)/⍵} check←∊∘(words←(~words∊⎕TC)⊆words←⊃⎕NGET⍵) long←(⍺≤≢¨words)/words ↑(⊂,parts)¨(∧/∘check∘parts¨long)/long
}</lang>
- Output:
alternade'p:\test\unixdict.txt' accost acs cot accuse acs cue afield ail fed agleam ala gem alcott act lot allele all lee allied ale lid alpert apr let ambient abet min annette ante net apport apr pot ariadne aide ran assist ass sit battle btl ate blaine ban lie brenda bed rna calliope clip aloe choose cos hoe choosy cos hoy claire car lie collude clue old effete eft fee fabric fbi arc fealty fat ely fluent fun let forwent fret own friend fin red george gog ere inroad ira nod israel ire sal jaunty jut any joanne jan one lounge lug one oriole oil roe oswald owl sad parrot pro art peoria poi era pierre per ire poodle pol ode pounce puc one racial rca ail realty rat ely sordid sri odd spatial sail pta sprain sri pan strain sri tan strait sri tat sturdy sud try sweaty set way tattle ttl ate theorem term hoe though tog huh throaty tray hot triode tid roe triune tin rue troupe top rue truant tun rat twirly til wry
AppleScript
<lang applescript>(*
Hard-coded for two-word alternades. Extracted texts are considered valid words if they too are in the input list.
- )
use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later use sorter : script "Custom Iterative Ternary Merge Sort" --<https://macscripter.net/viewtopic.php?pid=194430#p194430> use scripting additions
on alternades(inputList, minAlternadeLength, outputType)
-- Script object through which to reference potentially long lists for speed. -- Also contains a by-length comparison handler for the custom sort and a finishing-off handler for the final output. script o property wordList : inputList's items property validSubwords : {} property output : {} on isGreater(a, b) return (a's length > b's length) end isGreater on finish() if (outputType is text) then set astid to AppleScript's text item delimiters set AppleScript's text item delimiters to linefeed set output to output as text set AppleScript's text item delimiters to astid end if return output end finish end script (* Check the input and marshal it for a less slow search. *) set wordCount to (count o's wordList) if (wordCount < 3) then return o's finish() -- Sort the input words by length. tell sorter to sort(o's wordList, 1, wordCount, {comparer:o}) -- Get the length of the longest and deduce the maximum possible length of a subword. set maxWordLength to length of end of o's wordList if (maxWordLength < minAlternadeLength) then return o's finish() set maxSubwordLength to (maxWordLength + 1) div 2 -- Build a list of maxSubwordLength lists and populate the relevant ones so that -- a list with index n contains all the input words with n characters. repeat maxSubwordLength times set end of o's validSubwords to {} end repeat set startIndex to missing value set minSubwordLength to minAlternadeLength div 2 repeat with w from 1 to wordCount set thisWord to item w of o's wordList set wordLength to thisWord's length -- Note the wordList index at which the main repeat below will need to start. if ((wordLength = minAlternadeLength) and (startIndex is missing value)) then set startIndex to w if (wordLength ≥ minSubwordLength) then if (wordLength > maxSubwordLength) then exit repeat set end of item wordLength of o's validSubwords to thisWord end if end repeat (* Extract "subwords" from those words which have minAlternadeLength or more characters and check them against the words in validSubwords, appending any hit info to the output in either text or the default record form. *) set twoTabs to tab & tab set colonTwoTabs to ":" & twoTabs repeat with w from startIndex to wordCount set thisWord to item w of o's wordList set wordLength to thisWord's length set subword1 to character 1 of thisWord repeat with c from 3 to wordLength by 2 set subword1 to subword1 & character c of thisWord end repeat -- Only bother to extract the second subword if the first is approved. if (item ((wordLength + 1) div 2) of o's validSubwords contains subword1) then set subword2 to character 2 of thisWord repeat with c from 4 to wordLength by 2 set subword2 to subword2 & character c of thisWord end repeat if (item (wordLength div 2) of o's validSubwords contains subword2) then if (outputType is text) then set end of o's output to thisWord & (colonTwoTabs & subword1) & (twoTabs & subword2) else set end of o's output to {alternade:thisWord, subwords:{subword1, subword2}} end if end if end if end repeat return o's finish()
end alternades
-- Task code: local wordFile, wordList, minLength set wordFile to ((path to desktop as text) & "unixdict.txt") as «class furl» set wordList to words of (read wordFile as «class utf8») set minLength to 6 set outputType to text return alternades(wordList, minLength, outputType)</lang>
- Output:
accost: acs cot accuse: acs cue afield: ail fed agleam: ala gem alcott: act lot allele: all lee allied: ale lid alpert: apr let apport: apr pot assist: ass sit battle: btl ate blaine: ban lie brenda: bed rna choose: cos hoe choosy: cos hoy claire: car lie effete: eft fee fabric: fbi arc fealty: fat ely fluent: fun let friend: fin red george: gog ere inroad: ira nod israel: ire sal jaunty: jut any joanne: jan one lounge: lug one oriole: oil roe oswald: owl sad parrot: pro art peoria: poi era pierre: per ire poodle: pol ode pounce: puc one racial: rca ail realty: rat ely sordid: sri odd sprain: sri pan strain: sri tan strait: sri tat sturdy: sud try sweaty: set way tattle: ttl ate though: tog huh triode: tid roe triune: tin rue troupe: top rue truant: tun rat twirly: til wry ambient: abet min annette: ante net ariadne: aide ran collude: clue old forwent: fret own spatial: sail pta theorem: term hoe throaty: tray hot calliope: clip aloe
C
<lang C>#include <stdio.h>
- include <string.h>
- include <stdlib.h>
- include <errno.h>
- define WORD_BUF_SIZE 30
- define MIN_WORD_SIZE 6
/* Print last error and exit */ void fail(void) {
fprintf(stderr, "%s\n", strerror(errno)); exit(42);
}
/* Define a trie data structure to store the words */ struct trie_node {
char ch, final; struct trie_node *parent, *sibling, *root, *child;
};
struct trie_node *alloc_node() {
struct trie_node *t = calloc(1, sizeof(struct trie_node)); if (t == NULL) fail(); return t;
}
struct trie_node *make_sibling(struct trie_node *node) {
struct trie_node *t = alloc_node(); node->sibling = t; t->ch = node->ch; t->parent = node->parent; t->root = node->root; return t;
}
struct trie_node *make_child(struct trie_node *node, char ch) {
struct trie_node *t = alloc_node(); t->parent = node; t->ch = ch; t->root = node->root; node->child = t; return t;
}
/* Add a word to the trie */ struct trie_node *add_word(struct trie_node *root, const char *word) {
struct trie_node *cur = root; for (; *word; word++) { while (cur->child == NULL || cur->child->ch != *word) { if (cur->child == NULL) { /* Node does not exist yet; insert it */ make_child(cur, *word); } else { /* Check next sibling, if it exists */ if (cur->sibling == NULL) make_sibling(cur); cur = cur->sibling; } } /* We have either made or found the right node, descend */ cur = cur->child; } cur->final = 1; /* This node marks the end of a word */ return cur;
}
/* Check if a word is in the trie; returns the word or NULL if not there */ struct trie_node *find_word(struct trie_node *root, const char *word) {
struct trie_node *cur = root; for (; *word && cur; word++) { while (cur != NULL && cur->child != NULL && cur->child->ch != *word) { cur = cur->sibling; } if (cur == NULL) return NULL; /* node doesn't exist */ cur = cur->child; } if (cur && cur->final) return cur; else return NULL;
}
/* Call function for every word in the trie */ void scan_trie(struct trie_node *node, void callback(struct trie_node *)) {
if (node == NULL) return; if (node->final) callback(node); scan_trie(node->child, callback); scan_trie(node->sibling, callback);
}
/* Retrieve word from trie given pointer to end node */ char *get_word(struct trie_node *node, char *buffer) {
char t, *ch = buffer, *s = buffer; for (; node != NULL; node=node->parent) *ch++ = node->ch; for (ch-=2; ch >= s; ch--, s++) *ch ^= *s ^= *ch ^= *s; return buffer;
}
/* See if a word is an alternade, and print it if it is */ void check_alternade(struct trie_node *node) {
static char word[WORD_BUF_SIZE], even[WORD_BUF_SIZE], odd[WORD_BUF_SIZE]; char *p_even = even, *p_odd = odd; int i; /* Ignore words that are shorter than the minimum length */ if (strlen(get_word(node, word)) < MIN_WORD_SIZE) return; /* Make even and odd words */ for (i=0; word[i]; i++) { if (i & 1) *p_odd++ = word[i]; else *p_even++ = word[i]; } *p_odd = *p_even = '\0'; /* If both words exist, this is an alternade */ if (find_word(node->root, even) && find_word(node->root, odd)) { printf("%-20s%-10s%-10s\n", word, even, odd); }
}
int main(void) {
struct trie_node *root = alloc_node(); root->root = root; char word[WORD_BUF_SIZE], *nl; /* Read all words from stdin */ while (!feof(stdin)) { fgets(word, WORD_BUF_SIZE, stdin); if (nl = strchr(word, '\n')) *nl = '\0'; /* remove newline */ add_word(root, word); } /* Print all alternades */ scan_trie(root, check_alternade); return 0;
}</lang>
- Output:
$ ./alternade < unixdict.txt accost acs cot accuse acs cue afield ail fed agleam ala gem alcott act lot allele all lee allied ale lid alpert apr let ambient abet min annette ante net apport apr pot ariadne aide ran assist ass sit battle btl ate blaine ban lie brenda bed rna calliope clip aloe choose cos hoe choosy cos hoy claire car lie collude clue old effete eft fee fabric fbi arc fealty fat ely fluent fun let forwent fret own friend fin red george gog ere inroad ira nod israel ire sal jaunty jut any joanne jan one lounge lug one oriole oil roe oswald owl sad parrot pro art peoria poi era pierre per ire poodle pol ode pounce puc one racial rca ail realty rat ely sordid sri odd spatial sail pta sprain sri pan strain sri tan strait sri tat sturdy sud try sweaty set way tattle ttl ate theorem term hoe though tog huh throaty tray hot triode tid roe triune tin rue troupe top rue truant tun rat twirly til wry
Factor
<lang factor>USING: formatting io.encodings.ascii io.files kernel literals math sequences sequences.extras sets strings ;
<< CONSTANT: words $[ "unixdict.txt" ascii file-lines ] >>
CONSTANT: wordset $[ words HS{ } set-like ]
- word? ( str -- ? ) wordset in? ;
- subwords ( str -- str str )
dup <evens> >string swap <odds> >string ;
- alternade? ( str -- ? ) subwords [ word? ] both? ;
words [ alternade? ] filter [ length 5 > ] filter [ dup subwords "%-8s %-4s %-4s\n" printf ] each</lang>
- Output:
accost acs cot accuse acs cue afield ail fed agleam ala gem alcott act lot allele all lee allied ale lid alpert apr let ambient abet min annette ante net apport apr pot ariadne aide ran assist ass sit battle btl ate blaine ban lie brenda bed rna calliope clip aloe choose cos hoe choosy cos hoy claire car lie collude clue old effete eft fee fabric fbi arc fealty fat ely fluent fun let forwent fret own friend fin red george gog ere inroad ira nod israel ire sal jaunty jut any joanne jan one lounge lug one oriole oil roe oswald owl sad parrot pro art peoria poi era pierre per ire poodle pol ode pounce puc one racial rca ail realty rat ely sordid sri odd spatial sail pta sprain sri pan strain sri tan strait sri tat sturdy sud try sweaty set way tattle ttl ate theorem term hoe though tog huh throaty tray hot triode tid roe triune tin rue troupe top rue truant tun rat twirly til wry
Go
<lang go>package main
import (
"bytes" "fmt" "io/ioutil" "log" "unicode/utf8"
)
func main() {
b, err := ioutil.ReadFile("unixdict.txt") if err != nil { log.Fatal("Error reading file") } bwords := bytes.Fields(b) dict := make(map[string]bool, len(bwords)) words := make([]string, len(bwords)) for i, bword := range bwords { word := string(bword) dict[word] = true words[i] = word } fmt.Println("'unixdict.txt' contains the following alternades of length 6 or more:\n") count := 0 for _, word := range words { if utf8.RuneCountInString(word) < 6 { continue } var w1 = "" var w2 = "" for i, c := range word { if i%2 == 0 { w1 += string(c) } else { w2 += string(c) } } _, ok1 := dict[w1] _, ok2 := dict[w2] if ok1 && ok2 { count++ fmt.Printf("%2d: %-8s -> %-4s %-4s\n", count, word, w1, w2) } }
}</lang>
- Output:
'unixdict.txt' contains the following alternades of length 6 or more: 1: accost -> acs cot 2: accuse -> acs cue 3: afield -> ail fed 4: agleam -> ala gem 5: alcott -> act lot 6: allele -> all lee 7: allied -> ale lid 8: alpert -> apr let 9: ambient -> abet min 10: annette -> ante net 11: apport -> apr pot 12: ariadne -> aide ran 13: assist -> ass sit 14: battle -> btl ate 15: blaine -> ban lie 16: brenda -> bed rna 17: calliope -> clip aloe 18: choose -> cos hoe 19: choosy -> cos hoy 20: claire -> car lie 21: collude -> clue old 22: effete -> eft fee 23: fabric -> fbi arc 24: fealty -> fat ely 25: fluent -> fun let 26: forwent -> fret own 27: friend -> fin red 28: george -> gog ere 29: inroad -> ira nod 30: israel -> ire sal 31: jaunty -> jut any 32: joanne -> jan one 33: lounge -> lug one 34: oriole -> oil roe 35: oswald -> owl sad 36: parrot -> pro art 37: peoria -> poi era 38: pierre -> per ire 39: poodle -> pol ode 40: pounce -> puc one 41: racial -> rca ail 42: realty -> rat ely 43: sordid -> sri odd 44: spatial -> sail pta 45: sprain -> sri pan 46: strain -> sri tan 47: strait -> sri tat 48: sturdy -> sud try 49: sweaty -> set way 50: tattle -> ttl ate 51: theorem -> term hoe 52: though -> tog huh 53: throaty -> tray hot 54: triode -> tid roe 55: triune -> tin rue 56: troupe -> top rue 57: truant -> tun rat 58: twirly -> til wry
Julia
<lang julia>function alternade(wordfile, minlength, interval)
println("\nWord source: $wordfile") words = split(read(wordfile, String), r"\s+") dict, results = Dict(w => 1 for w in words), [] for word in words len, wordlist, isalternade = length(word), [word], true (len < minlength) && continue for n in 1:interval subword = mapreduce(i -> word[i], *, n:interval:len) if !haskey(dict, subword) isalternade = false break end push!(wordlist, subword) end isalternade && push!(results, wordlist) end println("Found: a total of ", length(results), " word", length(results) != 1 ? "s" : "", " of at least length $minlength spelling words in alternate letters of interval $interval.") for (i, lis) in enumerate(results) println(join([rpad("$i.", 4), rpad(lis[1], 20), [rpad(lis[j], 10) for j in 2:interval+1]...])) end
end
alternade("unixdict.txt", 6, 2) alternade("unixdict.txt", 12, 4)
</lang>
- Output:
Word source: unixdict.txt Found: a total of 58 words of at least length 6 spelling words in alternate letters of interval 2. 1. accost acs cot 2. accuse acs cue 3. afield ail fed 4. agleam ala gem 5. alcott act lot 6. allele all lee 7. allied ale lid 8. alpert apr let 9. ambient abet min 10. annette ante net 11. apport apr pot 12. ariadne aide ran 13. assist ass sit 14. battle btl ate 15. blaine ban lie 16. brenda bed rna 17. calliope clip aloe 18. choose cos hoe 19. choosy cos hoy 20. claire car lie 21. collude clue old 22. effete eft fee 23. fabric fbi arc 24. fealty fat ely 25. fluent fun let 26. forwent fret own 27. friend fin red 28. george gog ere 29. inroad ira nod 30. israel ire sal 31. jaunty jut any 32. joanne jan one 33. lounge lug one 34. oriole oil roe 35. oswald owl sad 36. parrot pro art 37. peoria poi era 38. pierre per ire 39. poodle pol ode 40. pounce puc one 41. racial rca ail 42. realty rat ely 43. sordid sri odd 44. spatial sail pta 45. sprain sri pan 46. strain sri tan 47. strait sri tat 48. sturdy sud try 49. sweaty set way 50. tattle ttl ate 51. theorem term hoe 52. though tog huh 53. throaty tray hot 54. triode tid roe 55. triune tin rue 56. troupe top rue 57. truant tun rat 58. twirly til wry Word source: unixdict.txt Found: a total of 1 word of at least length 12 spelling words in alternate letters of interval 4. 1. protectorate per rca ott toe
Perl
<lang perl>#!/usr/bin/perl
use strict; use warnings;
my $words = do { local (@ARGV, $/) = 'unixdict.txt'; <> }; my %words = map { $_, 1 } $words =~ /^.{3,}$/gm; for ( $words =~ /^.{6,}$/gm )
{ my $even = s/(.).?/$1/gr; my $odd = s/.(.?)/$1/gr; $words{$even} && $words{$odd} and print "$_ => [ $even $odd ]\n"; }</lang>
Phix
<lang Phix>object text = get_text("unixdict.txt") if not string(text) then
crash("unixdict.txt error, download from http://www.puzzlers.org/pub/wordlists/unixdict.txt")
end if sequence words = split_any(text," \r\n",no_empty:=true) constant minlens = {0,6,10,11,12,12} for n=2 to 6 do
sequence res = {} for i=1 to length(words) do string word = words[i] if length(word)>=minlens[n] then sequence sn = repeat("",n) for j=1 to length(word) do sn[mod(j-1,n)+1] &= word[j] end for if sum(sq_gt(apply(true,binary_search,{sn,{words}}),0))=n then res = append(res,prepend(sn,word)) end if end if end for printf(1,"\nEvery %s letter of length>=%d:\n",{ordinal(n),minlens[n]}) pp(shorten(res,"alternade words found",5),{pp_Nest,1})
end for </lang>
- Output:
Every second letter of length>=6: {{`accost`, `acs`, `cot`}, {`accuse`, `acs`, `cue`}, {`afield`, `ail`, `fed`}, {`agleam`, `ala`, `gem`}, {`alcott`, `act`, `lot`}, `...`, {`triode`, `tid`, `roe`}, {`triune`, `tin`, `rue`}, {`troupe`, `top`, `rue`}, {`truant`, `tun`, `rat`}, {`twirly`, `til`, `wry`}, ` (58 alternade words found)`} Every third letter of length>=10: {{`benevolent`, `belt`, `eve`, `non`}, {`rejuvenate`, `rune`, `eva`, `jet`}} Every fourth letter of length>=11: {{`meteorology`, `moo`, `erg`, `toy`, `el`}, {`protectorate`, `per`, `rca`, `ott`, `toe`}} Every fifth letter of length>=12: {{`inappropriate`, `ira`, `not`, `ape`, `pr`, `pi`}} Every sixth letter of length>=12: {{`aristotelean`, `at`, `re`, `il`, `se`, `ta`, `on`}, {`warehouseman`, `wu`, `as`, `re`, `em`, `ha`, `on`}}
Python
<lang python>WORDFILE = 'unixdict.txt' MINLEN = 6
class Trie(object):
"""Trie data structure""" class Node(object): """A node in the trie""" def __init__(self, char='\0', parent=None): self.children = {} self.char = char self.final = False self.parent = parent def descend(self, char, extend=False): """Descend into the trie""" if not char in self.children: if not extend: return None self.children[char] = Trie.Node(char,self) return self.children[char] def __init__(self): self.root = Trie.Node() def insert(self, word): """Insert a word in the trie""" node = self.root for char in word: node = node.descend(char, extend=True) node.final = True return node def __contains__(self, word): """See if the trie contains a word""" node = self.root for char in word: node = node.descend(char) if not node: return False return node.final def words(self): """Yield every word in the trie""" nodes = [self.root] while nodes: node = nodes.pop() nodes += node.children.values() if node.final: word = [] while node: if node.char != '\0': word.append(node.char) node = node.parent yield "".join(reversed(word)) def __iter__(self): return self.words()
words = Trie() with open(WORDFILE, "rt") as f:
for word in f.readlines(): words.insert(word.strip())
for word in words:
if len(word) < MINLEN: continue even = word[::2] odd = word[1::2] if even in words and odd in words: print(word, even, odd)</lang>
- Output:
twirly til wry truant tun rat troupe top rue triune tin rue triode tid roe throaty tray hot though tog huh theorem term hoe tattle ttl ate sweaty set way sturdy sud try strait sri tat strain sri tan sprain sri pan spatial sail pta sordid sri odd realty rat ely racial rca ail pounce puc one poodle pol ode pierre per ire peoria poi era parrot pro art oswald owl sad oriole oil roe lounge lug one joanne jan one jaunty jut any israel ire sal inroad ira nod george gog ere friend fin red forwent fret own fluent fun let fealty fat ely fabric fbi arc effete eft fee collude clue old claire car lie choosy cos hoy choose cos hoe calliope clip aloe brenda bed rna blaine ban lie battle btl ate assist ass sit ariadne aide ran apport apr pot annette ante net ambient abet min alpert apr let allied ale lid allele all lee alcott act lot agleam ala gem afield ail fed accuse acs cue accost acs cot
Raku
<lang perl6>unit sub MAIN ($file = 'unixdict.txt', :$min = 6);
my %words = $file.IO.slurp.words.map: * => 1;
my @alternades;
for %words {
next if .key.chars < $min; my @letters = .key.comb; my @alts = @letters[0,2 … *].join, @letters[1,3 … *].join; @alternades.push(.key => @alts) if %words{@alts[0]} && %words{@alts[1]};
}
@alternades.=sort;
say "{+@alternades} alternades longer than {$min-1} characters found in $file:";
.say for @alternades > 10
?? (flat @alternades.head(5), '...', @alternades.tail(5)) !! @alternades;</lang>
- Output:
58 alternades longer than 5 characters found in unixdict.txt: accost => [acs cot] accuse => [acs cue] afield => [ail fed] agleam => [ala gem] alcott => [act lot] ... triode => [tid roe] triune => [tin rue] troupe => [top rue] truant => [tun rat] twirly => [til wry]
REXX
version 1
This REXX version doesn't care what order the words in the dictionary are in, nor does it care what
case (lower/upper/mixed) the words are in, the search for alternades is caseless.
It also allows the minimum length to be specified on the command line (CL) as well as the dictionary file identifier. <lang rexx>/*REXX program finds all the caseless alternade words (within an identified dictionary).*/ parse arg minL iFID . /*obtain optional arguments from the CL*/ if minL== | minL=="," then minL= 6 /*Not specified? Then use the default.*/ if iFID== | iFID=="," then iFID='unixdict.txt' /* " " " " " " */ @.= /*default value of any dictionary word.*/
do #=1 while lines(iFID)\==0 /*read each word in the file (word=X).*/ x= strip( linein( iFID) ); xu= x /*pick off a word from the input line. */ upper xu; @.xu= .; $.#= x /*save semaphore and lowercase version.*/ end /*while*/ /* [↑] semaphore name is uppercased. */
nads= 0 /*count of the alternade words found. */ say copies('─', 30) # 'usable words in the dictionary file: ' iFID say
do j=1 for #-1; L= length($.j) /*process all the words that were found*/ if L<minL then iterate /*Is word too short? Then ignore it. */ od=; ev= /*initialize 2 parts of alternade word.*/ do k=1 for L; _= substr($.j, k, 1) /*build the " " " " " */ if k//2 then od= od || _ /* " " odd part " " " */ else ev= ev || _ /* " " even " " " " */ end /*k*/ parse upper value od ev with odU evU /*obtain the uppercase alternade parts.*/ if @.odU== | @.evU== then iterate /*either parts of alternade not extant?*/ nads= nads + 1 /*bump the count of alternades found.*/ say left($.j, 20) left(od, 10) left(ev, 10) /*indent a bit.*/ end /*j*/
say /*stick a fork in it, we're all done. */ say nads ' alternade words found with a minimum length of ' minL</lang>
- output when using the default inputs:
────────────────────────────── 25104 usable words in the dictionary file: unixdict.txt accost acs cot accuse acs cue afield ail fed agleam ala gem alcott act lot allele all lee allied ale lid alpert apr let ambient abet min annette ante net apport apr pot ariadne aide ran assist ass sit battle btl ate blaine ban lie brenda bed rna calliope clip aloe choose cos hoe choosy cos hoy claire car lie collude clue old effete eft fee fabric fbi arc fealty fat ely fluent fun let forwent fret own friend fin red george gog ere inroad ira nod israel ire sal jaunty jut any joanne jan one lounge lug one oriole oil roe oswald owl sad parrot pro art peoria poi era pierre per ire poodle pol ode pounce puc one racial rca ail realty rat ely sordid sri odd spatial sail pta sprain sri pan strain sri tan strait sri tat sturdy sud try sweaty set way tattle ttl ate theorem term hoe though tog huh throaty tray hot triode tid roe triune tin rue troupe top rue truant tun rat twirly til wry 58 alternade words found with a minimum length of 6
Version 2
Independently developed at the same time as version 1 :-) <lang rexx>/* REXX */ fid='d:\unix.txt' cnt.=0 /* cnt.n -> words of lenght n */ ww.=0 /* ww.* the words to be analyzed */ w.=0 /* w.word = 1 if word is in unix.txt */ Do While lines(fid)>0
l=linein(fid) /* a word */ ll=length(l) /* its length */ cnt.ll=cnt.ll+1 /* count it */ w.l=1 /* word is in unix.txt */ If ll>=6 Then Do /* worth to be analyzed */ z=ww.0+1 /* add it to the list */ ww.z=l ww.0=z End End
Say cnt.3 'three letter words' Say cnt.4 'four letter words' Say cnt.5 'five letter words' Say cnt.6 'six letter words' Say cnt.7 'seven letter words' Say cnt.8 'eight letter words' n=0 Do i=1 To ww.0
Parse Value split(ww.i) With u v If w.u & w.v Then Do n=n+1 Say format(n,2) left(ww.i,8) left(u,4) v End End
Exit split: Procedure /* split the word ino components */
Parse Arg w s.= Do While w<> Parse Var w uu +1 vv +1 w s.u=s.u||uu s.v=s.v||vv End Return s.u s.v</lang>
Output:
D:\>rexx alternade 796 three letter words 2187 four letter words 3161 five letter words 3873 six letter words 4060 seven letter words 3618 eight letter words 1 accost acs cot 2 accuse acs cue 3 afield ail fed 4 agleam ala gem 5 alcott act lot 6 allele all lee 7 allied ale lid 8 alpert apr let 9 ambient abet min 10 annette ante net 11 apport apr pot 12 ariadne aide ran 13 assist ass sit 14 battle btl ate 15 blaine ban lie 16 brenda bed rna 17 calliope clip aloe 18 choose cos hoe 19 choosy cos hoy 20 claire car lie 21 collude clue old 22 effete eft fee 23 fabric fbi arc 24 fealty fat ely 25 fluent fun let 26 forwent fret own 27 friend fin red 28 george gog ere 29 inroad ira nod 30 israel ire sal 31 jaunty jut any 32 joanne jan one 33 lounge lug one 34 oriole oil roe 35 oswald owl sad 36 parrot pro art 37 peoria poi era 38 pierre per ire 39 poodle pol ode 40 pounce puc one 41 racial rca ail 42 realty rat ely 43 sordid sri odd 44 spatial sail pta 45 sprain sri pan 46 strain sri tan 47 strait sri tat 48 sturdy sud try 49 sweaty set way 50 tattle ttl ate 51 theorem term hoe 52 though tog huh 53 throaty tray hot 54 triode tid roe 55 triune tin rue 56 troupe top rue 57 truant tun rat 58 twirly til wry
Ring
<lang ring> load "stdlib.ring"
cStr = read("unixdict.txt") wordList = str2list(cStr) sum = 0 see "working..." + nl + nl
for n = 1 to len(wordList)
wordOdd = "" wordEven = "" for m = 1 to len(wordList[n]) step 2 wordOdd = wordOdd + wordList[n][m] next for m = 2 to len(wordList[n]) step 2 wordEven = wordEven + wordList[n][m] next indOdd = find(wordList,wordOdd) indEven = find(wordList,wordEven) if indOdd > 0 and indEven > 0 and len(wordList[indOdd]) > 2 and len(wordList[indEven]) > 2 sum = sum + 1 see "" + sum + ". " see "word = " + wordList[n] + nl see "wordOdd = " + wordList[indOdd] + nl see "wordEven = " + wordList[indEven] + nl + nl ok
next see "done..." + nl </lang> Output:
working... 1. word = accost wordOdd = acs wordEven = cot 2. word = accuse wordOdd = acs wordEven = cue 3. word = afield wordOdd = ail wordEven = fed 4. word = agleam wordOdd = ala wordEven = gem 5. word = alcott wordOdd = act wordEven = lot 6. word = allele wordOdd = all wordEven = lee 7. word = allied wordOdd = ale wordEven = lid 8. word = alpert wordOdd = apr wordEven = let 9. word = ambient wordOdd = abet wordEven = min 10. word = annette wordOdd = ante wordEven = net 11. word = apport wordOdd = apr wordEven = pot 12. word = ariadne wordOdd = aide wordEven = ran 13. word = assist wordOdd = ass wordEven = sit 14. word = battle wordOdd = btl wordEven = ate 15. word = blaine wordOdd = ban wordEven = lie 16. word = brenda wordOdd = bed wordEven = rna 17. word = calliope wordOdd = clip wordEven = aloe 18. word = choose wordOdd = cos wordEven = hoe 19. word = choosy wordOdd = cos wordEven = hoy 20. word = claire wordOdd = car wordEven = lie 21. word = collude wordOdd = clue wordEven = old 22. word = effete wordOdd = eft wordEven = fee 23. word = fabric wordOdd = fbi wordEven = arc 24. word = fealty wordOdd = fat wordEven = ely 25. word = fluent wordOdd = fun wordEven = let 26. word = forwent wordOdd = fret wordEven = own 27. word = friend wordOdd = fin wordEven = red 28. word = george wordOdd = gog wordEven = ere 29. word = inroad wordOdd = ira wordEven = nod 30. word = israel wordOdd = ire wordEven = sal 31. word = jaunty wordOdd = jut wordEven = any 32. word = joanne wordOdd = jan wordEven = one 33. word = lounge wordOdd = lug wordEven = one 34. word = oriole wordOdd = oil wordEven = roe 35. word = oswald wordOdd = owl wordEven = sad 36. word = parrot wordOdd = pro wordEven = art 37. word = peoria wordOdd = poi wordEven = era 38. word = pierre wordOdd = per wordEven = ire 39. word = poodle wordOdd = pol wordEven = ode 40. word = pounce wordOdd = puc wordEven = one 41. word = racial wordOdd = rca wordEven = ail 42. word = realty wordOdd = rat wordEven = ely 43. word = sordid wordOdd = sri wordEven = odd 44. word = spatial wordOdd = sail wordEven = pta 45. word = sprain wordOdd = sri wordEven = pan 46. word = strain wordOdd = sri wordEven = tan 47. word = strait wordOdd = sri wordEven = tat 48. word = sturdy wordOdd = sud wordEven = try 49. word = sweaty wordOdd = set wordEven = way 50. word = tattle wordOdd = ttl wordEven = ate 51. word = theorem wordOdd = term wordEven = hoe 52. word = though wordOdd = tog wordEven = huh 53. word = throaty wordOdd = tray wordEven = hot 54. word = triode wordOdd = tid wordEven = roe 55. word = triune wordOdd = tin wordEven = rue 56. word = troupe wordOdd = top wordEven = rue 57. word = truant wordOdd = tun wordEven = rat 58. word = twirly wordOdd = til wordEven = wry done...
Wren
<lang ecmascript>import "io" for File import "/set" for Set import "/fmt" for Fmt
var wordList = "unixdict.txt" // local copy var set = Set.new() var words = File.read(wordList).trimEnd().split("\n") for (word in words) set.add(word) System.print("'unixdict.txt' contains the following alternades of length 6 or more:\n") var count = 0 for (word in words) {
if (word.count >= 6) { var w1 = "" var w2 = "" var i = 0 for (c in word) { if (i%2 == 0) { w1 = w1 + c } else { w2 = w2 + c } i = i + 1 } if (set.contains(w1) && set.contains(w2)) { count = count + 1 Fmt.print("$2d: $-8s -> $-4s $-4s", count, word, w1, w2) } }
}</lang>
- Output:
'unixdict.txt' contains the following alternades of length 6 or more: 1: accost -> acs cot 2: accuse -> acs cue 3: afield -> ail fed 4: agleam -> ala gem 5: alcott -> act lot 6: allele -> all lee 7: allied -> ale lid 8: alpert -> apr let 9: ambient -> abet min 10: annette -> ante net 11: apport -> apr pot 12: ariadne -> aide ran 13: assist -> ass sit 14: battle -> btl ate 15: blaine -> ban lie 16: brenda -> bed rna 17: calliope -> clip aloe 18: choose -> cos hoe 19: choosy -> cos hoy 20: claire -> car lie 21: collude -> clue old 22: effete -> eft fee 23: fabric -> fbi arc 24: fealty -> fat ely 25: fluent -> fun let 26: forwent -> fret own 27: friend -> fin red 28: george -> gog ere 29: inroad -> ira nod 30: israel -> ire sal 31: jaunty -> jut any 32: joanne -> jan one 33: lounge -> lug one 34: oriole -> oil roe 35: oswald -> owl sad 36: parrot -> pro art 37: peoria -> poi era 38: pierre -> per ire 39: poodle -> pol ode 40: pounce -> puc one 41: racial -> rca ail 42: realty -> rat ely 43: sordid -> sri odd 44: spatial -> sail pta 45: sprain -> sri pan 46: strain -> sri tan 47: strait -> sri tat 48: sturdy -> sud try 49: sweaty -> set way 50: tattle -> ttl ate 51: theorem -> term hoe 52: though -> tog huh 53: throaty -> tray hot 54: triode -> tid roe 55: triune -> tin rue 56: troupe -> top rue 57: truant -> tun rat 58: twirly -> til wry
XPL0
<lang XPL0>string 0; \use zero-terminated strings int Dict(26000); \pointers to words (enough for unixdict.txt) int DictSize; \actual number of pointers in Dict
func StrCmp(A, B); \Compare string A to B char A, B; \Returns: >0 if A>B, =0 if A=B, and <0 if A>1 do
[if A(I) # B(I) then return A(I) - B(I); if A(I) = 0 then return 0; ];
]; \StrCmp
func LookUp(Word); \Return 'true' if Word is in Dict char Word; int Lo, Hi, I, Cmp; [Lo:= 0; Hi:= DictSize-1; loop [I:= (Lo+Hi) / 2; \binary search
Cmp:= StrCmp(Word, Dict(I)); if Cmp < 0 then Hi:= I-1 else Lo:= I+1; if Cmp = 0 then return true; if Lo > Hi then return false; ];
]; \LookUp
int I, I0, I1, DI, Ch, Count; char Word, Alt0(25), Alt1(25); def Tab=$09, LF=$0A, CR=$0D, EOF=$1A;
[FSet(FOpen("unixdict.txt", 0), ^I); \load dictionary OpenI(3); \assume alphabetical order and all lowercase DI:= 0; \ignore non-alpha characters: 0..9, ' and & repeat Dict(DI):= Reserve(0); \get pointer to memory used to store Word
Word:= Dict(DI); I:= 0; loop [repeat Ch:= ChIn(3) until Ch # CR; \remove possible CR if Ch=LF or Ch=EOF then quit; Word(I):= Ch; I:= I+1; ]; Word(I):= 0; \terminate Word string I:= Reserve(I+1); \reserve memory used for Word DI:= DI+1; \next dictionary entry
until Ch = EOF; DictSize:= DI;
DI:= 0; Count:= 0; repeat Word:= Dict(DI); \print out all alternade words
I:= 0; I0:= 0; I1:= 0; loop [Ch:= Word(I); \get even and odd alternades if Ch = 0 then quit; if I&1 then [Alt1(I1):= Ch; I1:= I1+1] else [Alt0(I0):= Ch; I0:= I0+1]; I:= I+1; ]; if I >= 6 then \Word must have at least 6 chars [Alt0(I0):= 0; Alt1(I1):= 0; if LookUp(Alt0) & LookUp(Alt1) then [Count:= Count+1; IntOut(0, Count); ChOut(0, Tab); Text(0, Word); ChOut(0, Tab); Text(0, Alt0); ChOut(0, Tab); Text(0, Alt1); CrLf(0); ]; ]; DI:= DI+1;
until DI >= DictSize; ]</lang>
- Output:
1 accost acs cot 2 accuse acs cue 3 afield ail fed 4 agleam ala gem 5 alcott act lot 6 allele all lee 7 allied ale lid 8 alpert apr let 9 ambient abet min 10 annette ante net 11 apport apr pot 12 ariadne aide ran 13 assist ass sit 14 battle btl ate 15 blaine ban lie 16 brenda bed rna 17 calliope clip aloe 18 choose cos hoe 19 choosy cos hoy 20 claire car lie 21 collude clue old 22 effete eft fee 23 fabric fbi arc 24 fealty fat ely 25 fluent fun let 26 forwent fret own 27 friend fin red 28 george gog ere 29 inroad ira nod 30 israel ire sal 31 jaunty jut any 32 joanne jan one 33 lounge lug one 34 oriole oil roe 35 oswald owl sad 36 parrot pro art 37 peoria poi era 38 pierre per ire 39 poodle pol ode 40 pounce puc one 41 racial rca ail 42 realty rat ely 43 sordid sri odd 44 spatial sail pta 45 sprain sri pan 46 strain sri tan 47 strait sri tat 48 sturdy sud try 49 sweaty set way 50 tattle ttl ate 51 theorem term hoe 52 though tog huh 53 throaty tray hot 54 triode tid roe 55 triune tin rue 56 troupe top rue 57 truant tun rat 58 twirly til wry