Anagrams/Deranged anagrams: Difference between revisions
(→{{header|PHP}}: Output?) |
|||
Line 828: | Line 828: | ||
=={{header|PHP}}== |
=={{header|PHP}}== |
||
{{output?|PHP}} |
|||
<lang PHP><?php |
<lang PHP><?php |
||
$words = file( |
$words = file( |
||
Line 878: | Line 877: | ||
foreach ($final_words as $final_word) { |
foreach ($final_words as $final_word) { |
||
echo implode(" ", $final_word), "\n"; |
echo implode(" ", $final_word), "\n"; |
||
} |
|||
?></lang> |
|||
{{out}} |
|||
<pre> |
|||
excitation intoxicate |
|||
</pre> |
|||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
Revision as of 19:03, 5 June 2012
You are encouraged to solve this task according to the task description, using any language you may know.
Two or more words are said to be anagrams if they have the same characters, but in a different order. By analogy with derangements we define a deranged anagram as two words with the same characters, but in which the same character does not appear in the same position in both words.
The task is to use the word list at http://www.puzzlers.org/pub/wordlists/unixdict.txt to find and show the longest deranged anagram.
- Cf.
Ada
<lang Ada>with Ada.Text_IO; use Ada.Text_IO; with Ada.Containers.Generic_Array_Sort; with Ada.Containers.Indefinite_Vectors; procedure Danagrams is
package StringVector is new Ada.Containers.Indefinite_Vectors (Positive, String); procedure StrSort is new Ada.Containers.Generic_Array_Sort (Index_Type => Positive, Element_Type => Character, Array_Type => String); function Derange (s1 : String; s2 : String) return Boolean is begin for i in s1'Range loop if (s1 (i) = s2 (i)) then return False; end if; end loop; return True; end Derange; File : File_Type; len, foundlen : Positive := 1; Vect, SVect : StringVector.Vector; index, p1, p2 : StringVector.Extended_Index := 0;
begin
Open (File, In_File, "unixdict.txt"); while not End_Of_File (File) loop declare str : String := Get_Line (File); begin len := str'Length; if len > foundlen then Vect.Append (str); StrSort (str); index := 0; loop -- Loop through anagrams by index in vector of sorted strings index := SVect.Find_Index (str, index + 1); exit when index = StringVector.No_Index; if Derange (Vect.Last_Element, Vect.Element (index)) then p1 := Vect.Last_Index; p2 := index; foundlen := len; end if; end loop; SVect.Append (str); end if; end; end loop; Close (File); Put_Line (Vect.Element (p1) & " " & Vect.Element (p2));
end Danagrams;</lang>
- Output:
intoxicate excitation
Bracmat
The file is read into a single string, wordList
. Then, in a while loop, each line is read and, in a nested loop, atomised into single letters. The letters are added together to create a sorted list that is the letter sum, the 'anagram fingerprint', of the word. To make sure that even single letter words create a sum of at least two terms, the sum is initialised with the empty string rather than zero. (Otherwise the words a and aaa later on would get the same fingerprint, the factors 1
and 3
being factored out.)
For the word bizarre the letter sum is (+a+b+e+2*r+z+i)
. The letter sum, with the word as the exponent ((+a+b+e+2*r+z+i)^bizarre
) is prepended to a list unsorted
. Somewhat later the word brazier also is prepended to the unsorted
list. This word happens to have the same letter sum as bizarre, so these two words must be anagrams of each other. The program brings these two elements together by merge sorting the unsorted
list, using Bracmat's Computer Algebra powers to normalise sums and products by sorting and combining like terms or factors. During the sort, all elements in the the unsorted
list are multiplied together, combining factors with the same letter sums by adding their exponents together. So at some stage during sorting, the two elements (+a+b+e+2*r+z+i)^bizarre
and (+a+b+e+2*r+z+i)^brazier
are brought together in a product (+a+b+e+2*r+z+i)^bizarre*(+a+b+e+2*r+z+i)^brazier
which immediately is transformed to the single factor (+a+b+e+2*r+z+i)^(bizarre+brazier)
. In the product of all elements the anagrams are to be found in the exponents consisting of a sum of at least two terms. To find the longest deranged anagrams, we traverse the product list to find all exponents with multiple words, check that the length of the first word is at least as long as the length of the longest deranged anagram up to now, and check each pair of words for being deranged. If a pair of deranged anagrams is found with more letters than previously found deranged anagrams, the earlier finds are forgotten. If the new anagrams are the same length, however, they are added to the output.
The Bracmat solution to the similar task anagrams skips the explicit merge sort and instead prepends new factors directly to the product one by one. Bracmat shuffles each new factor into place to keep the growing product normalized before continuing with the next word from the list. The result is exactly the same, but the running time becomes much longer. <lang bracmat> get$("unixdict.txt",STR):?wordList & 1:?product & :?unsorted & whl
' ( @(!wordList:(%?word:?letterString) \n ?wordList) & :?letterSum & whl ' ( @(!letterString:%?letter ?letterString) & (!letter:~#|str$(N !letter))+!letterSum : ?letterSum ) & !letterSum^!word !unsorted:?unsorted )
& ( mergeSort
= newL L first second . !arg:?L & whl ' ( !L:% % & :?newL & whl ' ( !L:%?first %?second ?L & !first*!second !newL:?newL ) & !L !newL:?L ) & !L )
& mergeSort$!unsorted:?product & 0:?maxLength:?oldMaxLength & :?derangedAnagrams & ( deranged
= nextLetter Atail Btail . !arg : ( (.) | ( @(?:%@?nextLetter ?Atail) . @(?:(%@:~!nextLetter) ?Btail) ) & deranged$(!Atail.!Btail) ) )
& ( !product
: ? * ? ^ ( %+% : @(%:? ([~<!maxLength:[?maxLength))+? : ? + %@?anagramA + ? + %@?anagramB + ( ? & deranged$(!anagramA.!anagramB) & (!anagramA.!anagramB) ( !maxLength:>!oldMaxLength:?oldMaxLength & | !derangedAnagrams ) : ?derangedAnagrams & ~ ) ) * ? | out$!derangedAnagrams );</lang>
Output:
excitation.intoxicate
C
<lang C>#include <stdio.h>
- include <stdlib.h>
- include <string.h>
- include <unistd.h>
- include <sys/types.h>
- include <fcntl.h>
- include <sys/stat.h>
typedef struct { char *key, *word; } wtuple;
int deranged(char *s1, char *s2) { while (*s1 != '\0') if (*(s1++) == *(s2++)) return 0;
return 1; }
int cmp_tuple(const void *a, const void *b) { const wtuple *x = a, *y = b; int l1 = strlen(x->key), l2 = strlen(y->key); return l1 > l2 ? -1 : l1 < l2 ? 1 :strcmp(x->key, y->key); }
/* sort letters in a string */ void char_sort(char *ptr, int len) { int i, j; char tmp; /* bubble sort, O(n) shmoen */ for (i = 0; i < len; i++) for (j = i + 1; j < len; j++) if (ptr[i] > ptr[j]) { tmp = ptr[i]; ptr[i] = ptr[j]; ptr[j] = tmp; } }
int main() { int i, j, k, n_words = 0; char *words, *keys; struct stat st; wtuple *t;
int fd = open("unixdict.txt", O_RDONLY); fstat(fd, &st);
words = malloc(st.st_size); read(fd, words, st.st_size); close(fd);
keys = malloc(st.st_size); memcpy(keys, words, st.st_size);
/* count words, change all new line to null, and sort each key */ for (i = j = 0; i < st.st_size; i++) { if (words[i] != '\n') continue; n_words ++; words[i] = keys[i] = '\0'; char_sort(keys + j, i - j); j = i; }
/* make key-word tuples */ t = malloc(sizeof(wtuple) * n_words); for (j = k = i = 0; i < st.st_size; i++) { if (words[i] != '\0') continue; t[j].key = keys + k; t[j].word = words + k; k = ++i; j++; }
/* sort t by key length / key order */ qsort(t, n_words, sizeof(wtuple), cmp_tuple); for (i = 0, j = 0; j < n_words; j++) { if (strcmp(t[i].key, t[j].key)) i = j; else if (deranged(t[i].word, t[j].word)) break; }
printf("longest derangement: %s %s\n", t[i].word, t[j].word); return 0; }</lang>
- Output:
longest derangement: excitation intoxicate
CoffeeScript
This example was tested with node.js. <lang coffeescript>http = require 'http'
is_derangement = (word1, word2) ->
for c, i in word1 return false if c == word2[i] true
show_longest_derangement = (word_lst) ->
anagrams = {} max_len = 0 for word in word_lst continue if word.length < max_len key = word.split().sort().join() if anagrams[key] for prior in anagrams[key] if is_derangement(prior, word) max_len = word.length result = [prior, word] else anagrams[key] = [] anagrams[key].push word console.log "Longest derangement: #{result.join ' '}"
get_word_list = (process) ->
options = host: "www.puzzlers.org" path: "/pub/wordlists/unixdict.txt" req = http.request options, (res) -> s = res.on 'data', (chunk) -> s += chunk res.on 'end', -> process s.split '\n' req.end()
get_word_list show_longest_derangement</lang>
- Output:
> coffee anagrams.coffee Longest derangement: excitation intoxicate
Common Lisp
<lang lisp>(defun read-words (file)
(with-open-file (stream file) (loop with w = "" while w collect (setf w (read-line stream nil)))))
(defun deranged (a b)
(loop for ac across a for bc across b always (char/= ac bc)))
(defun longest-deranged (file)
(let ((h (make-hash-table :test #'equal))
(wordlist (sort (read-words file) #'(lambda (x y) (> (length x) (length y))))))
(loop for w in wordlist do
(let* ((ws (sort (copy-seq w) #'char<)) (l (gethash ws h))) (loop for w1 in l do (if (deranged w w1) (return-from longest-deranged (list w w1)))) (setf (gethash ws h) (cons w l))))))
(format t "~{~A~%~^~}" (longest-deranged "unixdict.txt"))</lang>
- Output:
intoxicate excitation
D
<lang d>import std.stdio, std.file, std.string, std.algorithm, std.range;
auto findAnagrams(Range)(Range words) /*pure nothrow*/ {
string[][const ubyte[]] anagrams; // assume input is ASCII foreach (w; words) anagrams[(cast(ubyte[])w).sort().release().idup] ~= w.idup; return anagrams.byValue.filter!q{ a.length > 1 }().array();
}
const(string)[2][] findDeranged(in string[] words) /*pure nothrow*/ {
typeof(return) result; foreach (i, w1; words) foreach (w2; words[i+1 .. $]) if (zip(w1, w2).all!q{ a[0] != a[1] }()) result ~= [w1, w2]; return result;
}
auto largestDerangedAna(string[][] anagrams) /*nothrow*/ {
anagrams.schwartzSort!(a => -a[0].length)(); return anagrams.map!findDeranged().filter!q{ a.length }();
}
void main() {
//auto words = readText("unixdict.txt").splitter(); auto words = std.array.splitter(readText("unixdict.txt")); writeln("Longest deranged anagrams:"); auto der = largestDerangedAna(findAnagrams(words)); if (!der.empty) writeln(der.front);
}</lang>
- Output:
Longest deranged anagrams: [["excitation", "intoxicate"]]
Faster version
<lang d>import std.stdio, std.file, std.string, std.algorithm,
std.typecons, std.range;
auto findDeranged(in string[] words) /*pure nothrow*/ {
Tuple!(const string, const string)[] result; foreach (i, w1; words) foreach (w2; words[i+1 .. $]) if (!zip(w1, w2).canFind!q{ a[0] == a[1] }()) result ~= tuple(w1, w2); return result;
}
void main() {
Appender!(string[])[30] wclasses; foreach (word; std.algorithm.splitter(readText("unixdict.txt"))) wclasses[$ - word.length].put(word); auto r = filter!q{ a.length }(map!q{ a.data }(wclasses[])); writeln("Longest deranged anagrams:"); foreach (words; r) { string[][const ubyte[]] anags; // assume input is ASCII foreach (w; words) anags[(cast(ubyte[])w).sort().release().idup] ~= w.idup; const anas = anags.values.filter!q{ a.length > 1 }().array(); auto pairs = anas.map!findDeranged().filter!q{ a.length }(); if (!pairs.empty) { writefln(" %s, %s", pairs.front[0].tupleof); break; } }
}</lang>
- Output:
Longest deranged anagrams: excitation, intoxicate
GAP
Using function Anagrams. <lang gap>IsDeranged := function(a, b) local i, n; for i in [1 .. Size(a)] do if a[i] = b[i] then return false; fi; od; return true; end;
- This solution will find all deranged pairs of any length.
Deranged := function(name) local sol, ana, u, v; sol := [ ]; ana := Anagrams(name); for u in ana do for v in Combinations(u, 2) do if IsDeranged(v[1], v[2]) then Add(sol, v); fi; od; od; return sol; end;
- Now we find all deranged pairs of maximum length
a := Deranged("unixdict.txt");; n := Maximum(List(a, x -> Size(x[1]))); Filtered(a, x -> Size(x[1]) = n);
- [ [ "excitation", "intoxicate" ] ]</lang>
Go
<lang go>package main import ( "fmt" "io/ioutil" "strings" "sort" )
func deranged(a, b string) bool { if len(a) != len(b) { return false } for i := range(a) { if a[i] == b[i] { return false } } return true }
func main() { /* read the whole thing in. how big can it be? */ buf, _ := ioutil.ReadFile("unixdict.txt") words := strings.Split(string(buf), "\n")
m := make(map[string] []string) best_len, w1, w2 := 0, "", ""
for _, w := range(words) { // don't bother: too short to beat current record if len(w) <= best_len { continue }
// save strings in map, with sorted string as key letters := strings.Split(w, "") sort.Strings(letters) k := strings.Join(letters, "")
if _, ok := m[k]; !ok { m[k] = []string { w } continue }
for _, c := range(m[k]) { if deranged(w, c) { best_len, w1, w2 = len(w), c, w break } }
m[k] = append(m[k], w) }
fmt.Println(w1, w2, ": Length", best_len) }</lang>
- Output:
excitation intoxicate : Length 10
Haskell
If the longest deranged anagram includes three or more words we'll only print two of them. We also correctly handle duplicate words in the input. <lang haskell>import Control.Arrow import Data.List import Data.Ord import qualified Data.Map as M import qualified Data.Set as S
-- Group lists of words based on their "signatures". A signature is a sorted -- list of characters. Handle duplicate input words by storing them in sets. groupBySig = map (sort &&& S.singleton)
-- Convert groups to lists of equivalent words. equivs = map (S.toList . snd) . M.toList . M.fromListWith S.union
-- Indicate whether the pair of words differ in all character positions. isDerangement (a, b) = and $ zipWith (/=) a b
-- Return all pairs of elements, ignoring order. pairs = concat . unfoldr step
where step (x:xs) = Just (map ((,) x) xs, xs) step [] = Nothing
-- Return all anagram pairs in the input string. anagrams = concatMap pairs . equivs . groupBySig
-- Return the pair of words making the longest deranged anagram. maxDerangedAnagram = maxByLen . filter isDerangement . anagrams
where maxByLen [] = Nothing maxByLen xs = Just $ maximumBy (comparing (length . fst)) xs
main :: IO () main = do
input <- getContents case maxDerangedAnagram $ words input of Nothing -> putStrLn "No deranged anagrams were found." Just (a, b) -> putStrLn $ "Longest deranged anagrams: " ++ a ++ " and " ++ b</lang>
- Output:
Longest deranged anagrams: excitation and intoxicate
Icon and Unicon
This solution (which works in both languages) does a strict interpretation of the problem and ignores the fact that there may be multiple derangements that are the same length (including ignoring multiple derangements arising from the same set of words that are all anagrams). <lang unicon>link strings # for csort() procedure
procedure main()
anagrams := table() # build lists of anagrams every *(word := !&input) > 1 do { canon := csort(word) /anagrams[canon] := [] put(anagrams[canon], word) }
longest := 1 # find a longest derangement every *(aList := !anagrams) > 1 do if derangement := derange(aList) then if longest <:= *derangement[1] then long := derangement
every writes((!\long||" ")|"\n") # show longest
end
procedure derange(aList) # Return a single derangement from this list
while aWord := get(aList) do return noMatch(aWord, !aList)
end
procedure noMatch(s1,s2) # Produce pair only if s1,s2 are deranged.
every i := 1 to *s1 do if s1[i] == s2[i] then fail return [s1,s2]
end</lang>
- Sample run:
->dra <unixdict.txt excitation intoxicate ->
J
This assumes that unixdict.txt has been saved in the current directory. <lang j> #words=: <;._2 ] 1!:1 <'unixdict.txt' 25104
#anagrams=: (#~ 1 < #@>) (</.~ /:~&>) words
1303
#maybederanged=: (#~ (1 -.@e. #@~."1)@|:@:>&>) anagrams
432
#longest=: (#~ [: (= >./) #@>@{.@>) maybederanged
1
longest
┌───────────────────────┐
│┌──────────┬──────────┐│
││excitation│intoxicate││
│└──────────┴──────────┘│
└───────────────────────┘</lang>
Note that anagram sets with more than two members might, hypothetically, have made things more complicated. By lucky coincidence, this was not an issue. We could have taken advantage of that coincidence to achieve slight further simplifications. Perhaps maybederanged=: (#~ (-: ~."1)@|:@:>&>) anagrams
In other words, if we had had to consider whether ascertain/cartesian/sectarian
contained a deranged pair, we would have had to break it out into the three pairs it contains. However, since 'excitation' is a longer word than 'ascertain', we know that this triple cannot contain the longest deranged anagram pair. And since there are no anagrams longer than 'excitation' which involve more than a single pair, we know that we can ignore this issue entirely.
Java
<lang java>import java.io.*; import java.util.*;
public class DerangedAnagrams {
public static void main(String[] args) throws IOException { String[][] anagrams = findAnagrams(readLines("unixdict.txt")); String[] res = null; for (String[] ana : anagrams) { int j = ana[0].length() - 1; while (j >= 0 && ana[0].charAt(j) != ana[1].charAt(j)) { j--; } if (j == -1) { res = ana; break; } } System.out.printf("result: %s %s\n", res[0], res[1]); }
static String[][] findAnagrams(String[] words) { Map<String, ArrayList<String>> map = new LinkedHashMap<String, ArrayList<String>>(); for (String w : words) { char[] srt = w.toCharArray(); Arrays.sort(srt); String key = String.valueOf(srt); if (map.containsKey(key)) { map.get(key).add(w); } else { ArrayList<String> v = new ArrayList<String>(); v.add(w); map.put(key, v); } } List<String[]> pairs = new ArrayList<String[]>(); for (List<String> v : map.values()) { if (v.size() > 1) { String[] wrds = v.toArray(new String[]{}); for (int i = 0; i < wrds.length - 1; i++) { pairs.add(new String[]{wrds[i], wrds[i + 1]}); } } } return pairs.toArray(new String[][]{}); }
static public String[] readLines(String fn) throws IOException { BufferedReader br = new BufferedReader(new FileReader(fn)); List<String> lines = new ArrayList<String>(); String line = null; while ((line = br.readLine()) != null) lines.add(line.trim()); br.close(); Collections.sort(lines, new Comparator<String>() { public int compare(String a, String b) { return b.length() - a.length(); } }); return lines.toArray(new String[]{}); }
}</lang>
- Output:
result: excitation intoxicate
JavaScript
Word file is saved locally because browser won't fetch it cross-site. Tested on Gecko.
<lang javascript><html><head><title>Intoxication</title></head>
<body>
<script type="application/javascript">
function show(t) { var l = document.createTextNode(t + '\n'); document.getElementById('x').appendChild(l); }
// get words; be ware of cross-site restrictions on XMLHttpRequest var words = null; var req = new XMLHttpRequest(); req.open('GET', 'file:///tmp/unixdict.txt', false); req.send(null); words = req.responseText.split('\n');
var idx = {}; for (var i = 0; i < words.length; i++) { var t = words[i].split().sort().join(); if (idx[t]) idx[t].push(words[i]); else idx[t] = [words[i]]; }
var best = ; var best_pair; for (var i in idx) { if (i.length <= best.length) continue; if (idx[i].length == 1) continue;
var a = idx[i], got = null; for (var j = 0, l1 = a[j]; j < a.length && !got; j++) { for (var k = j + 1, l2 = a[k]; k < a.length && !got; k++) for (var m = 0; m < l1.length || !(got = [l2]); m++) if (l1[m] == l2[m]) break; if (got) got.push(l1); }
if (got) { best_pair = got; best = got[0]; } }
show(best_pair); </script></body></html></lang>
K
<lang K> / anagram clusters
a:{x g@&1<#:'g:={x@<x}'x}@0:"unixdict.txt"; / derangements in these clusters b@&c=|/c:{#x[0]}'b:a@&{0=+//{x=y}':x}'a
("excitation"
"intoxicate")</lang>
OCaml
<lang ocaml>let sort_chars s =
let r = String.copy s in for i = 0 to (String.length r) - 2 do for j = i + 1 to (String.length r) - 1 do if r.[i] > r.[j] then begin let tmp = r.[i] in r.[i] <- r.[j]; r.[j] <- tmp; end done done; (r)
let deranged (s1, s2) =
let len1 = String.length s1 and len2 = String.length s2 in if len1 <> len2 then false else try for i = 0 to pred len1 do if s1.[i] = s2.[i] then raise Exit done; true with Exit -> false
let pairs_of_list lst =
let rec aux acc = function | [] -> acc | x::xs -> aux (List.fold_left (fun acc y -> (x,y)::acc) acc xs) xs in aux [] lst
let () =
let h = Hashtbl.create 3571 in let ic = open_in "unixdict.txt" in try while true do let word = input_line ic in let key = sort_chars word in let l = try Hashtbl.find h key with Not_found -> [] in Hashtbl.add h key (word::l); done with End_of_file -> close_in ic; let lst = Hashtbl.fold (fun _ lw acc -> if List.length lw < 2 then acc else lw::acc) h [] in let lst = List.fold_left (fun acc anagrams -> let pairs = pairs_of_list anagrams in (List.filter deranged pairs) @ acc ) [] lst in let res, _ = List.fold_left (fun (res, n) (w1, w2) -> let len = String.length w1 in match Pervasives.compare len n with | 0 -> ((w1, w2)::res, n) | 1 -> ([w1, w2], len) | _ -> (res, n) ) ([], 0) lst in List.iter (fun (w1, w2) -> Printf.printf "%s, %s\n" w1 w2) res</lang>
- Output:
$ ocaml deranged_anagram.ml intoxicate, excitation
Perl
<lang Perl>sub deranged { # only anagrams ever get here
my @a = split(, shift); # split word into letters my @b = split(, shift); for (0 .. $#a) { $a[$_] eq $b[$_] and return; } return 1
}
sub find_deranged {
for my $i ( 0 .. $#_ ) { for my $j ( $i+1 .. $#_ ) { next unless deranged $_[$i], $_[$j];
print "length ", length($_[$i]), ": $_[$i] => $_[$j]\n"; return 1; } }
}
my %letter_list; open my $in, 'unixdict.txt';
local $/ = undef;
for (split(' ', <$in>)) {
# store anagrams in hash table by letters they contain push @{ $letter_list{ join(, sort split(, $_)) } }, $_
}
for ( sort { length($b) <=> length($a) } # sort by length, descending
grep { @{ $letter_list{$_} } > 1 } # take only ones with anagrams keys %letter_list )
{
# if we find a pair, they are the longested due to the sort before last if find_deranged(@{ $letter_list{$_} });
}</lang>
- Output:
length 10: excitation => intoxicate
PicoLisp
<lang PicoLisp>(let Words NIL
(in "unixdict.txt" (while (line) (let (Word @ Key (pack (sort (copy @)))) (if (idx 'Words Key T) (push (car @) Word) (set Key (list Word)) ) ) ) ) (maxi '((X) (length (car X))) (extract '((Key) (pick '((Lst) (and (find '((L) (not (find = L Lst))) (val Key) ) (cons (pack @) (pack Lst)) ) ) (val Key) ) ) (idx 'Words) ) ) )</lang>
- Output:
-> ("excitation" . "intoxicate")
Perl 6
Note that, to make runtime manageable, we have created a subset file: <lang bash>grep '^[ie]' unixdict.txt > dict.ie</lang> <lang perl6>my %anagram = slurp('dict.ie').words.map({[.comb]}).classify({ .sort.join });
for %anagram.values.sort({ -@($_[0]) }) -> @aset {
for 0 ..^ @aset.end -> $i { for $i ^.. @aset.end -> $j { if none( @aset[$i].list Zeq @aset[$j].list ) { say "{@aset[$i].join} {@aset[$j].join}"; exit; } } }
}</lang>
- Output:
excitation intoxicate
PHP
<lang PHP><?php $words = file(
'http://www.puzzlers.org/pub/wordlists/unixdict.txt', FILE_IGNORE_NEW_LINES
); $length = 0;
foreach ($words as $word) {
$chars = str_split($word); sort($chars); $chars = implode("", $chars); $length = strlen($chars); $anagrams[$length][$chars][] = $word;
}
krsort($anagrams);
foreach ($anagrams as $anagram) {
$final_words = array(); foreach ($anagram as $words) { if (count($words) >= 2) { $counts = array(); foreach ($words as $word) { $counts[$word] = array($word); foreach ($words as $second_word) { for ($i = 0, $length = strlen($word); $i < $length; $i++) { if ($word[$i] === $second_word[$i]) continue 2; } $counts[$word][] = $second_word; } } $max = 0; $max_key = ; foreach ($counts as $name => $count) { if (count($count) > $max) { $max = count($count); $max_key = $name; } } if ($max > 1) { $final_words[] = $counts[$max_key]; } } } if ($final_words) break;
}
foreach ($final_words as $final_word) {
echo implode(" ", $final_word), "\n";
} ?></lang>
- Output:
excitation intoxicate
Prolog
<lang Prolog>longest_deranged_anagram :- http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt',In,[]), read_file(In, [], Out), close(In), msort(Out, MOut), group_pairs_by_key(MOut, GPL), map_list_to_pairs(compute_len, GPL, NGPL), predsort(my_compare, NGPL, GPLSort), search_derangement(GPLSort).
% order tuples to have longest words first
my_compare(R, N1-(K1-E1), N2-(K2-E2)) :-
( N1 < N2 -> R = > ; N1 > N2 -> R = <;
length(E1, L1),
length(E2, L2),
( L1 < L2 -> R = <; L1 > L2 -> R = >; compare(R, K1, K2))).
compute_len(_-[H|_], Len) :-
length(H, Len).
% check derangement of anagrams
derangement([], []).
derangement([H1|T1], [H2 | T2]) :-
H1 \= H2,
derangement(T1, T2).
search_derangement([_-(_-L) | T]) :-
length(L, 1), !,
search_derangement(T).
search_derangement([_-(_-L) | T]) :-
( search(L) -> true; search_derangement(T)).
search([]) :- fail. search([H | T]) :- ( search_one(H, T) -> true; search(T)).
search_one(Word, L) :-
include(derangement(Word), L, [H|_]),
atom_codes(W, Word),
atom_codes(W1, H),
format('Longest deranged anagrams : ~w ~w ~n', [W, W1]).
read_file(In, L, L1) :-
read_line_to_codes(In, W),
( W == end_of_file ->
L1 = L
;
msort(W, W1),
atom_codes(A, W1),
read_file(In, [A-W | L], L1)).</lang>
- Output:
?- longest_deranged_anagram. Longest deranged anagrams : excitation intoxicate true.
PureBasic
<lang PureBasic>Structure anagram
word.s letters.s
EndStructure
Structure wordList
List words.anagram()
EndStructure
- True = 1
- False = 0
Procedure.s sortLetters(*word.Character, wordLength)
;returns a string with the letters of a word sorted Protected Dim letters.c(wordLength) Protected *letAdr = @letters() CopyMemoryString(*word, @*letAdr) SortArray(letters(), #PB_Sort_Ascending, 0, wordLength - 1) ProcedureReturn PeekS(@letters(), wordLength)
EndProcedure
- Compare a list of anagrams for derangement.
Procedure isDeranged(List anagram.s())
;If a pair of deranged anagrams is found return #True ;and and modify the list to include the pair of deranged anagrams. Protected i, length, word.s, *ptrAnagram, isDeranged Protected NewList deranged.s() FirstElement(anagram()) length = Len(anagram()) Repeat word = anagram() *ptrAnagram = @anagram() While NextElement(anagram()) isDeranged = #True For i = 1 To length If Mid(word, i, 1) = Mid(anagram(), i, 1) isDeranged = #False Break ;exit for/next EndIf Next If isDeranged AddElement(deranged()) deranged() = anagram() AddElement(deranged()) deranged() = word CopyList(deranged(), anagram()) ProcedureReturn #True ;deranged anagram found EndIf Wend ChangeCurrentElement(anagram(), *ptrAnagram) Until Not NextElement(anagram()) ProcedureReturn #False ;deranged anagram not found
EndProcedure
If OpenConsole()
;word file is assumed to be in the same directory If Not ReadFile(0,"unixdict.txt"): End: EndIf Define maxWordSize = 0, word.s, length Dim wordlists.wordList(maxWordSize) ;Read word file and create separate lists of anagrams and their original ;words by length. While Not Eof(0) word = ReadString(0) length = Len(word) If length > maxWordSize maxWordSize = length Redim wordlists.wordList(maxWordSize) EndIf AddElement(wordlists(length)\words()) wordlists(length)\words()\word = word wordlists(length)\words()\letters = sortLetters(@word, length) Wend CloseFile(0) Define offset = OffsetOf(anagram\letters), option = #PB_Sort_Ascending Define sortType = #PB_Sort_String Define letters.s, foundDeranged NewList anagram.s() ;start search from largest to smallest For length = maxWordSize To 2 Step -1 If FirstElement(wordlists(length)\words()) ;only examine lists with words ;sort words to place anagrams next to each other SortStructuredList(wordlists(length)\words(), option, offset, sortType) With wordlists(length)\words() letters = \letters AddElement(anagram()): anagram() = \word ;Compose sets of anagrams and check for derangement with remaining ;words in current list. While NextElement(wordlists(length)\words()) ;Check for end of a set of anagrams? If letters <> \letters ;if more than one word in a set of anagrams check for derangement If ListSize(anagram()) > 1 If isDeranged(anagram()) foundDeranged = #True ;found deranged anagrams, stop processing Break 2 ;exit while/wend and for/next EndIf EndIf letters = \letters ;setup for next set of anagrams ClearList(anagram()) EndIf AddElement(anagram()): anagram() = \word Wend EndWith EndIf ClearList(anagram()) Next ;report results If foundDeranged Print("Largest 'Deranged' anagrams found are of length ") PrintN(Str(length) + ":" + #CRLF$) ForEach anagram() PrintN(" " + anagram()) Next Else PrintN("No 'Deranged' anagrams were found." + #CRLF$) EndIf Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() CloseConsole()
EndIf</lang>
- Output:
Largest 'Deranged' anagrams found are of length 10: intoxicate excitation
Python
<lang python>import urllib.request from collections import defaultdict from itertools import combinations
def getwords(url='http://www.puzzlers.org/pub/wordlists/unixdict.txt'):
return list(set(urllib.request.urlopen(url).read().decode().split()))
def find_anagrams(words):
anagram = defaultdict(list) # map sorted chars to anagrams for word in words: anagram[tuple(sorted(word))].append( word ) return dict((key, words) for key, words in anagram.items() if len(words) > 1)
def is_deranged(words):
'returns pairs of words that have no character in the same position' return [ (word1, word2) for word1,word2 in combinations(words, 2) if all(ch1 != ch2 for ch1, ch2 in zip(word1, word2)) ]
def largest_deranged_ana(anagrams):
ordered_anagrams = sorted(anagrams.items(), key=lambda x:(-len(x[0]), x[0])) for _, words in ordered_anagrams: deranged_pairs = is_deranged(words) if deranged_pairs: return deranged_pairs return []
if __name__ == '__main__':
words = getwords('http://www.puzzlers.org/pub/wordlists/unixdict.txt') print("Word count:", len(words))
anagrams = find_anagrams(words) print("Anagram count:", len(anagrams),"\n")
print("Longest anagrams with no characters in the same position:") print(' ' + '\n '.join(', '.join(pairs) for pairs in largest_deranged_ana(anagrams)))</lang>
- Output:
Word count: 25104 Anagram count: 1303 Longest anagrams with no characters in the same position: excitation, intoxicate
Faster Version
<lang python>from itertools import izip, ifilter from collections import defaultdict
def find_deranged(words):
result = [] for i, w1 in enumerate(words): for w2 in words[i+1:]: if all(a != b for a,b in izip(w1, w2)): result.append((w1, w2)) return result
def main():
wclasses = [[] for _ in xrange(30)] for word in open("unixdict.txt").read().split(): wclasses[-len(word)].append(word) print "Longest deranged anagrams:" for words in ifilter(None, wclasses): anags = defaultdict(list) for w in words: anags["".join(sorted(w))].append(w) anas = (find_deranged(a) for a in anags.itervalues() if len(a)>1) pairs = filter(None, anas) if pairs: print " %s, %s" % (pairs[0][0]) break
main()</lang>
- Output:
Longest deranged anagrams: excitation, intoxicate
R
<lang R>puzzlers.dict <- readLines("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
longest.deranged.anagram <- function(dict=puzzlers.dict) {
anagram.groups <- function(word.group) { sorted <- sapply(lapply(strsplit(word.group,""),sort),paste, collapse="") grouped <- tapply(word.group, sorted, force, simplify=FALSE) grouped <- grouped[sapply(grouped, length) > 1] grouped[order(-nchar(names(grouped)))] } derangements <- function(anagram.group) { pairs <- expand.grid(a = anagram.group, b = anagram.group, stringsAsFactors=FALSE) pairs <- subset(pairs, a < b) deranged <- with(pairs, mapply(function(a,b) all(a!=b), strsplit(a,""), strsplit(b,""))) pairs[which(deranged),] }
for (anagram.group in anagram.groups(dict)) { if (nrow(d <- derangements(anagram.group)) > 0) { return(d[1,]) } }
}</lang>
- Output:
<lang R>> longest.deranged.anagram()
a b
3 excitation intoxicate</lang>
Ruby
<lang ruby>require 'open-uri' anagram = nil open('http://www.puzzlers.org/pub/wordlists/unixdict.txt') do |f|
anagram = f.read.split.group_by {|s| s.each_char.sort}
end
def deranged?(a, b)
a.chars.zip(b.chars).all? {|char_a, char_b| char_a != char_b}
end
def remove_non_derangements(val)
list = val.dup for i in 0 ... list.length j = i + 1 while j < list.length if deranged?(list[i], list[j]) j += 1 else list.delete_at(j) end end end list
end
max_word_length = anagram.each_value .
select {|list| list.length > 1} . map {|list| list[0].length} . max
derangements = []
until derangements.length > 1
puts "looking for deranged anagrams with word length #{max_word_length}"
anagram.each_value . select {|list| list.length > 1 and list[0].length == max_word_length} . each do |list| derangements = remove_non_derangements(list) break if derangements.length > 1 end
max_word_length -= 1
end
puts "derangement with longest word length: #{derangements}"</lang>
- Output:
looking for deranged anagrams with word length 12 looking for deranged anagrams with word length 11 looking for deranged anagrams with word length 10 derangement with longest word length: ["excitation", "intoxicate"]
Run BASIC
<lang runbasic>a$ = httpGet$("http://www.puzzlers.org/pub/wordlists/unixdict.txt") dim theWord$(30000) dim ssWord$(30000)
c10$ = chr$(10) i = 1 while instr(a$,c10$,i) <> 0
j = instr(a$,c10$,i) ln = j - i again = 1 sWord$ = mid$(a$,i,j-i) n = n + 1 theWord$(n) = sWord$
while again = 1 again = 0 for kk = 1 to len(sWord$) - 1 if mid$(sWord$,kk,1) > mid$(sWord$,kk +1,1) then sWord$ = left$(sWord$,kk-1);mid$(sWord$,kk+1,1);mid$(sWord$,kk,1);mid$(sWord$,kk+2) again = 1 end if next kk wend ssWord$(n) = sWord$ i = j + 1
wend
for i = 1 to n
if len(theWord$(i)) > maxLen then for j = 1 to n if ssWord$(i) = ssWord$(j) and i <> j then cnt = 0
for k = 1 to len(theWord$(i)) if mid$(theWord$(i),k,1) = mid$(theWord$(j),k,1) then cnt = cnt + 1 next k if cnt = 0 then maxLen = len(theWord$(i)) maxPtrI = i maxPtrJ = j end if
end if next j end if
next i
print maxLen;" ";theWord$(maxPtrI);" => ";theWord$(maxPtrJ)
end</lang>Output:
10 excitation => intoxicate
Scala
<lang scala>object DerangedAnagrams {
/** Returns a map of anagrams keyed by the sorted characters */ def groupAnagrams(words: Iterable[String]): Map[String, Set[String]] = words.foldLeft (Map[String, Set[String]]()) { (map, word) => val sorted = word.sorted val entry = map.getOrElse(sorted, Set.empty) map + (sorted -> (entry + word)) } /* Returns true if the pair of strings has no positions with the same * characters */ def isDeranged(ss: (String, String)): Boolean = ss._1 zip ss._2 forall { case (c1, c2) => c1 != c2 } /* Returns pairwise combination of all Strings in the argument Iterable */ def pairWords(as: Iterable[String]): Iterable[(String, String)] = if (as.size < 2) Seq() else (as.tail map (as.head -> _)) ++ pairWords(as.tail) /* Returns the contents of the argument URL as an Iterable[String], each * String is one line in the file */ def readLines(url: String): Iterable[String] = io.Source.fromURL(url).getLines().toIterable val wordsURL = "http://www.puzzlers.org/pub/wordlists/unixdict.txt" def main(args: Array[String]): Unit = { val anagramMap = groupAnagrams(readLines(wordsURL)) val derangedPairs = anagramMap.values flatMap (pairWords) filter (isDeranged) val (w1, w2) = derangedPairs maxBy (pair => pair._1.length) println("Longest deranged pair: "+w1+" and "+w2) }
}</lang>
- Output:
Longest deranged pair: excitation and intoxicate
Tcl
<lang tcl>package require Tcl 8.5 package require http
- Fetch the words
set t [http::geturl "http://www.puzzlers.org/pub/wordlists/unixdict.txt"] set wordlist [split [http::data $t] \n] http::cleanup $t
- Group by characters in word
foreach word $wordlist {
dict lappend w [lsort [split $word ""]] [split $word ""]
}
- Deranged test
proc deranged? {l1 l2} {
foreach c1 $l1 c2 $l2 {
if {$c1 eq $c2} {return 0}
} return 1
}
- Get a deranged pair from an anagram set, if one exists
proc getDeranged {words} {
foreach l1 [lrange $words 0 end-1] {
foreach l2 [lrange $words 1 end] { if {[deranged? $l1 $l2]} { return [list $l1 $l2 1] } }
} return {{} {} 0}
}
- Find the max-length deranged anagram
set count 0 set candidates {} set max 0 dict for {k words} $w {
incr count [expr {[llength $words] > 1}] if {[llength $k] > $max && [lassign [getDeranged $words] l1 l2]} {
set max [llength $l1] lappend candidates [join $l1 ""],[join $l2 ""]
}
}
- Print out what we found
puts "[llength $wordlist] words" puts "[dict size $w] potential anagram-groups" puts "$count real anagram-groups" foreach pair $candidates {
puts "considered candidate pairing: $pair"
} puts "MAXIMAL DERANGED ANAGRAM: LENGTH $max\n\t[lindex $candidates end]"</lang>
- Output:
25105 words 23567 potential anagram-groups 1303 real anagram-groups considered candidate pairing: abc,cab considered candidate pairing: abed,bade considered candidate pairing: abort,bator considered candidate pairing: afresh,shafer considered candidate pairing: alberto,latrobe considered candidate pairing: american,cinerama considered candidate pairing: ancestral,lancaster considered candidate pairing: excitation,intoxicate MAXIMAL DERANGED ANAGRAM: LENGTH 10 excitation,intoxicate
TUSCRIPT
<lang tuscript>$$ MODE TUSCRIPT,{} requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
DICT anagramm CREATE 99999
COMPILE
LOOP word=requestdata -> ? : any character charsInWord=STRINGS (word," ? ") charString =ALPHA_SORT (charsInWord)
DICT anagramm LOOKUP charString,num,freq,wordalt,wlalt IF (num==0) THEN WL=SIZE (charString) DICT anagramm APPEND/QUIET/COUNT charString,num,freq,word,wl;" " ELSE DICT anagramm APPEND/QUIET/COUNT charString,num,freq,word,"";" " ENDIF ENDLOOP
DICT anagramm UNLOAD charString,all,freq,anagrams,wl
index =DIGIT_INDEX (wl) reverseIndex =REVERSE (index) wl =INDEX_SORT (wl,reverseIndex) freq =INDEX_SORT (freq,reverseIndex) anagrams =INDEX_SORT (anagrams,reverseIndex) charString =INDEX_SORT (charString,reverseIndex)
LOOP fr=freq,a=anagrams,w=wl
IF (fr==1) cycle asplit=SPLIT (a,": :") a1=SELECT (asplit,1,arest) a1split=STRINGS (a1," ? ") LOOP r=arest rsplit=STRINGS (r," ? ") LOOP v1=a1split,v2=rsplit IF (v1==v2) EXIT,EXIT ENDLOOP PRINT "Largest deranged anagram (length: ",w,"):" PRINT a STOP ENDLOOP
ENDLOOP ENDCOMPILE</lang>
- Output:
Largest deranged anagram (length: 10): excitation intoxicate
Ursala
This solution assumes the file unixdict.txt
is passed to the compiler as a command line parameter.
<lang Ursala>#import std
anagrams = |=tK33lrDSL2SL ~=&& ==+ ~~ -<&
deranged = filter not zip; any ==
- cast %sW
main = leql$^&l deranged anagrams unixdict_dot_txt</lang>
The anagrams
function is a little slow as defined above, but can be sped up by at least two orders of magnitude by grouping the words into classes of equal length, and sorting each word once in advance instead of each time a comparison is made as shown below.
<lang Ursala>anagrams = @NSiXSlK2rSS *= ^(-<&,~&)*; |=rSStFtK33lrDSL2SL ~=@br&& ==@bl</lang>
We can speed it up by about another factor of 5 by starting from the group of longest words and stopping as soon as a deranged anagram is found instead of generating all anagrams.
<lang Ursala>#import std
longest_deranged_anagram =
@NSiXSlK2rSS leql-<x&h; @NiX ~&lZrB->l ^\~&rt @rh -+
~&a^& ~&plrEkZ?ah/~&ah ~&fatPR, ^(-<&,~&)*; |=rSStFtK33lrDSL2SL ~=@br&& ==@bl+-
- cast %sW
main = longest_deranged_anagram unixdict_dot_txt</lang>
- Output:
('excitation','intoxicate')