Alternade words: Difference between revisions
m
→{{header|Wren}}: Minor tidy
(FutureBasic solution added) |
m (→{{header|Wren}}: Minor tidy) |
||
(10 intermediate revisions by 7 users not shown) | |||
Line 437:
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (
use sorter : script ¬
"Custom Iterative Ternary Merge Sort" --<www.macscripter.net/t/timsort-and-nigsort/71383/3>
use scripting additions
on binarySearch(v, theList, l, r)
script o
property lst : theList
end script
repeat until (l = r)
set m to (l + r) div 2
if (o's lst's item m < v) then
set l to m + 1
else
set r to m
end if
end repeat
if (o's lst's item l = v) then return l
return 0
end binarySearch
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
on alternades(inputList, subsPerAlternade, minAlternadeLen, outputType)
script o
property wordList : inputList's items
property
property output : {}
-- Custom comparison handler for the sort.
on isGreater(a, b)
set lenB to b's length
if (lenA = lenB) then return (a > b)
return (lenA > lenB)
end isGreater
on finish()
if (outputType is text) then set output to join(output, linefeed)
return output
end finish
end script
set wordCount to (count o's wordList)
if (wordCount
-- Sort the
tell sorter to sort(o's wordList, 1, wordCount, {comparer:o})
--
set
if (
set maxSubLen to (maxWordLen + subsPerAlternade - 1) div subsPerAlternade
-- Give the searchRanges list that many slots.
repeat maxSubLen times
set end of o's searchRanges to missing value
end repeat
--
--
-- Also find the index in wordList of the first word whose length ≥ minAlternadeLen.
set
set minAltLenStart to 1
set currentLength to o's
repeat with j from 2 to wordCount
set wordLen to o's wordList's item j's length
if (wordLen > currentLength) then
set o's searchRanges's item currentLength to {i, j - 1}
if (
set minAltLenStart to j
else if (wordLen > maxSubLen) then
exit repeat
end if
end if
end if
set i to j
set currentLength to wordLen
end if
end repeat
-- words from the
if (outputType is text) then set end of o's output to ""
repeat with w from minAltLenStart to wordCount -- Per long-enough word.
set thisWord to o's wordList's item w
set
set
set sub to thisWord's character s
repeat with c from (s + subsPerAlternade) to wordLen by subsPerAlternade -- Per chr.
end repeat
if ((range = missing
(binarySearch(sub, o's wordList, range's beginning, range's end) = 0)) then ¬
exit repeat
set end
end repeat
if ((count
if (outputType is text) then
set beginning of
set end of o's output to
else
set end of o's output to {alternade:thisWord,
end if
end if
end repeat
return o's finish()
Line 536 ⟶ 557:
-- Task code:
local wordFile, wordList
set wordFile to ((path to desktop as text) & "www.rosettacode.org:unixdict.txt") as «class furl»
set wordList to words of (read wordFile as «class utf8»)
-- Return two-word alternades of 6 or more characters. Result
return alternades(wordList, 2, 6, text)</syntaxhighlight>
{{output}}
<syntaxhighlight lang="applescript">"
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"</syntaxhighlight>
=={{header|Arturo}}==
Line 1,162 ⟶ 1,176:
truant tun rat
twirly til wry
</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|Classes,StdCtrls,SysUtils}}
Delphi-style problem solving, using standard Delphi
controls like the TStringList, which greatly simplifies
the solution.
<syntaxhighlight lang="Delphi">
unit Alternade;
interface
uses Classes,StdCtrls,SysUtils;
procedure FindAlternadeWords(Memo: TMemo);
implementation
var Dict: TStringList; {List holds dictionary}
function GetAlts(S: string; var Alt1,Alt2: string): boolean;
{Grab Alternades from string and test if they are valid }
var I: integer;
begin
Alt1:='';
Alt2:='';
{Copy every other letter into different string}
for I:=1 to Length(S) do
if (I mod 2)=0 then Alt2:=Alt2+S[I]
else Alt1:=Alt1+S[I];
{Check if the two strings are in the dictionary}
Result:=(Dict.IndexOf(Alt1)>=0) and (Dict.IndexOf(Alt2)>=0);
end;
procedure FindAlternadeWords(Memo: TMemo);
{test all words in the dictionary}
{And diplays the Alternade words in the Memo}
var I,Cnt: integer;
var Alt1,Alt2: string;
begin
Cnt:=0;
for I:=0 to Dict.Count-1 do
if (Length(Dict[I])>=6) and GetAlts(Dict[I], Alt1, Alt2) then
begin
Inc(Cnt);
Memo.Lines.Add(IntToStr(Cnt)+': '+Dict[I]+' '+Alt1+' '+Alt2);
end
end;
initialization
{Create/load dictionary}
Dict:=TStringList.Create;
Dict.LoadFromFile('unixdict.txt');
Dict.Sorted:=True;
finalization
Dict.Free;
end.
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
Line 1,233 ⟶ 1,373:
twirly -> til * wry
</pre>
=={{header|Factor}}==
<syntaxhighlight lang="factor">USING: formatting io.encodings.ascii io.files kernel literals
Line 1,405 ⟶ 1,547:
=={{header|FutureBasic}}==
<syntaxhighlight lang="futurebasic">
#plist NSAppTransportSecurity @{NSAllowsArbitraryLoads:YES}
local fn Words as CFArrayRef
CFURLRef url = fn URLWithString( @"https://web.archive.org/web/20180611003215/http://www.puzzlers.org/pub/wordlists/unixdict.txt" )
Line 1,411 ⟶ 1,556:
void local fn DoIt
text,,,,, 80
dispatchglobal
for wd
wd1 = fn StringByAppendingString( wd1, mid(wd,i,1) )
else
wd2 = fn StringByAppendingString( wd2, mid(wd,i,1) )
end if
next
if ( fn ArrayContainsObject( words, wd1 ) and fn ArrayContainsObject( words, wd2 ) )
dispatchmain
print wd,wd1,wd2
dispatchend
end if
end if
dispatchend
end fn
Line 1,441 ⟶ 1,588:
{{out}}
<pre style="height:
accost acs cot
accuse acs cue
Line 1,450 ⟶ 1,597:
allied ale lid
alpert apr let
ambient
annette
apport apr pot
ariadne
assist
battle btl ate
blaine ban lie
brenda bed rna
calliope
choose cos hoe
choosy cos hoy
claire car lie
collude
effete eft fee
fabric fbi arc
fealty fat ely
fluent fun let
forwent
friend fin red
george gog ere
Line 1,485 ⟶ 1,632:
realty rat ely
sordid sri odd
spatial
sprain sri
strain sri
strait sri
sturdy sud
sweaty set
tattle
theorem
though
throaty
triode
triune
troupe
truant
twirly
</pre>
Line 1,763 ⟶ 1,910:
=={{header|Java}}==
The 'userdict.txt' file is great, except it contains entries like 'mrs' and '1st'.<br />
Testing a word for at least one vowel, and 'a-z' is necessary for this task.
<syntaxhighlight lang="java">
import java.io.BufferedReader;
import java.io.FileReader;
import java.io.IOException;
import java.util.Set;
import java.util.TreeSet;
static String
static {
alphabet =
for (int index = 0; index < 26;
alphabet += (char) (index +
boolean alphabetic(String string) {
if
}
return true;
}
boolean containsVowel(String string) {
for (char vowel : vowels) {
if (string.contains(String.valueOf(vowel)))
return true;
}
return false;
}
void alternateWords() throws IOException {
Set<String> dictionary = new TreeSet<>();
try (BufferedReader reader = new BufferedReader(new FileReader("unixdict.txt"))) {
String line;
while ((line = reader.readLine()) != null) {
if (!alphabetic(line) || !containsVowel(line))
continue;
}
}
StringBuilder wordA = new
StringBuilder wordB = new StringBuilder();
for (String word : dictionary) {
int length = word.length();
if (length < 6)
continue;
wordA.setLength(0);
wordB.setLength(0);
for (int index = 0; index < length; index += 2) {
wordA.append(word.charAt(index));
if (index + 1 < length)
wordB.append(word.charAt(index + 1));
}
if (dictionary.contains(wordA.toString()))
if (dictionary.contains(wordB.toString()))
System.out.printf("%-15s%5s %s%n", word, wordA, wordB);
}
}
}
</syntaxhighlight>
<pre>
accost acs cot
annette ante net
apport apr pot
assist ass sit
choosy cos hoy
fabric fbi arc
george gog ere
strain sri tan
triode tid roe
troupe top rue
</pre>
Line 2,105 ⟶ 2,278:
truant->{tun,rat}
twirly->{til,wry}</pre>
=={{header|MiniScript}}==
This implementation is for use with the [http://miniscript.org/MiniMicro Mini Micro] version of MiniScript. The command-line version does not include a HTTP library. Modify the declaration of wordList object to use the file class to read a local copy of the word list file.
<syntaxhighlight lang="miniscript">
alternateLetters = function(word, ix)
if ix != 0 then ix = 1
altWord = ""
for i in range(ix, word.len - 1, 2)
altWord += word[i]
end for
return altWord
end function
wordList = http.get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt").split(char(10))
ctr = 0
for word in wordList
if word.len > 5 then
word1 = alternateLetters(word, 0)
word2 = alternateLetters(word, 1)
if wordList.indexOf(word1) != null and wordList.indexOf(word2) != null then
ctr += 1
print [ctr, word, char(18), word1, word2].join(" ")
end if
end if
end for
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|Nim}}==
Line 2,184 ⟶ 2,444:
57: throaty → tray hot
58: calliope → clip aloe</pre>
=={{header|OCaml}}==
<syntaxhighlight lang="ocaml">module StrSet = Set.Make(String)
let seq_lines ch =
let rec repeat () =
match input_line ch with
| s -> Seq.Cons (s, repeat)
| exception End_of_file -> Nil
in repeat
let min_len l s =
l <= String.length s
let get_alternade set s =
let s0 = String.init (succ (String.length s) lsr 1) (fun i -> s.[i + i])
and s1 = String.init (String.length s lsr 1) (fun i -> s.[i + succ i]) in
if StrSet.mem s0 set && StrSet.mem s1 set
then Some (Printf.sprintf "%s | %s %s" s s0 s1) else None
let () =
let set = seq_lines stdin |> Seq.filter (min_len 3) |> StrSet.of_seq in
StrSet.to_seq set |> Seq.filter (min_len 6)
|> Seq.filter_map (get_alternade set) |> Seq.iter print_endline</syntaxhighlight>
{{out}}
<pre style="max-height:20em">
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
</pre>
=={{header|Perl}}==
Line 3,686 ⟶ 4,031:
{{libheader|Wren-set}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
import "./set" for Set
import "./fmt" for Fmt
var wordList = "unixdict.txt" // local copy
|