Anagrams/Deranged anagrams

Anagrams/Deranged anagrams
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.

• Permutations/Derangements
• Best shuffle

Ada

Works with: Ada 2005

<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

AutoHotkey

This example does not show the output mentioned in the task description on this page (or a page linked to from here). Please ensure that it meets all task requirements and remove this message. Note that phrases in task descriptions such as "print and display" and "print and show" for example, indicate that (reasonable length) output be a part of a language's solution.

<lang Autohotkey>

       #NoEnv  ; Recommended for performance and compatibility with future AutoHotkey releases.
       ; #Warn  ; Enable warnings to assist with detecting common errors.
       SendMode Input  ; Recommended for new scripts due to its superior speed and reliability.
       SetWorkingDir %A_ScriptDir%  ; Ensures a consistent starting directory.
       SetBatchLines   -1
       FileDelete, Rosetta.txt
       file := fileOpen("unixdict.TXT", "r"), file1 := fileOpen("Rosetta.txt", "a")
       while !file.AtEOF
       {
               m_M := file.ReadLine()
       StrOut := StrLen(m_m) - 2 . "," . m_m . "`n"
       file1.Write(strOut)
               strOut := ""
       }
       FileRead, Contents, Rosetta.txt
       if not ErrorLevel  ; Successfully loaded.
       {
           Sort Contents, N R
           FileDelete, Rosetta(N).txt
               FileAppend, %contents%, Rosetta(N).txt
               Contents =  ; Free the memory.
       }
          
   FileRead, MyFile, Rosetta(N).txt
                   filereadline, m_m, Rosetta(N).txt, A_index
                                  
                           loop, parse, MyFile, `n, `r
                           {
                                   m_M := A_loopfield
                           ;~ tooltip, %A_index%, %A_index%, 1
                           ;~ MsgBox % m_M
               StringSplit, No_Let, m_M, `,
                           if ( No_let0 = 0 )
                                   goto, label
               if ( old1 = no_let1 )
                               string .= old2 "`n"
                       if ( old1 != no_let1 )
               {
                      
                       string .= old2
                       string := trim(string)
       ;========================================================================================================================================
                       if ( old2 != "" )
                       Loop, parse, string, `n, `r  ; Specifying `n prior to `r allows both Windows and Unix files to be parsed.
       line_number := A_Index
       if ( line_number > 1 )
       {
                       Loop, parse, string, `n, `r
                       {
                               StringSplit, NewStr, A_loopfield, `, ; break the string based on Comma
                               StringSplit, name, newstr2
                               loop, % newstr1
                                       K .= name%A_index% " "
                               sort k, D%A_Space%
                               k := RegExReplace( k, "\s", "" )
                               file .= "`r`n" k . "," . newstr1 . "," . newstr2
                                k =
                       }
                       sort File
                       loop, parse, file, `n, `r
                       {
                               if ( A_loopfield != "" )
                               {
                               StringSplit, T_C, A_loopfield, `,
                               if ( old = T_C1 )
                               {
                                               StringSplit, Final_C1, T_C3
                                                               StringSplit, Final_C2, old3
                                                               loop, 1
                                                               {
                                                                  Loop % T_C2
                                                               {
                                                                       if (final_C1%A_index% = final_C2%A_index%)
                                                                               break 2`
                                                               }
                                                                ;~ MsgBox % T_C3 . " " . old3
                                                                                                                            List .= T_C3 . " " . old3 "`r`n"
                                                                                                                            ;~ tooltip, %T_C3%, list, 1
                                                                                                                           }
                               }
                               old := T_C1, old3 := T_C3
                               }
                       }
               file =          
       }
       string =
       }
       old1 := no_let1,     old2 := m_m
           ;MsgBox here
       }
           label:
           clipboard =
           MsgBox % list
           Clipboard := list
       exitapp
       esc::exitapp

</lang>

intoxicate excitation
lancaster ancestral
sideboard broadside
greenland englander
.
.
.
.
nm mn
on no
un nu
vt tv

BBC BASIC

Works with: BBC BASIC for Windows

<lang bbcbasic> INSTALL @lib$+"SORTLIB"

     Sort% = FN_sortinit(0,0)
     
     DIM dict$(26000), sort$(26000), indx%(26000)
     
     REM Load the dictionary:
     dict% = OPENIN("C:\unixdict.txt")
     IF dict%=0 ERROR 100, "No dictionary file"
     index% = 0
     REPEAT
       index% += 1
       dict$(index%) = GET$#dict%
       indx%(index%) = index%
     UNTIL EOF#dict%
     CLOSE #dict%
     Total% = index%
     
     TIME = 0
     REM Sort the letters in each word:
     FOR index% = 1 TO Total%
       sort$(index%) = FNsortstring(dict$(index%))
     NEXT
     
     REM Sort the sorted words:
     C% = Total%
     CALL Sort%, sort$(1), indx%(1)
     
     REM Find anagrams and deranged anagrams:
     maxlen% = 0
     maxidx% = 0
     FOR index% = 1 TO Total%-1
       IF sort$(index%) = sort$(index%+1) THEN
         One$ = dict$(indx%(index%))
         Two$ = dict$(indx%(index%+1))
         FOR c% = 1 TO LEN(One$)
           IF MID$(One$,c%,1) = MID$(Two$,c%,1) EXIT FOR
         NEXT
         IF c%>LEN(One$) IF c%>maxlen% maxlen% = c% : maxidx% = index%
       ENDIF
     NEXT
     
     PRINT "The longest deranged anagrams are '" dict$(indx%(maxidx%));
     PRINT "' and '" dict$(indx%(maxidx%+1)) "'"
     PRINT "(taking " ; TIME/100 " seconds)"
     END
     
     DEF FNsortstring(A$)
     LOCAL C%, a&()
     C% = LEN(A$)
     DIM a&(C%)
     $$^a&(0) = A$
     CALL Sort%, a&(0)
     = $$^a&(0)</lang>

Output:

The longest deranged anagrams are 'excitation' and 'intoxicate'
(taking 0.95 seconds)

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>

1. include <stdlib.h>
2. include <string.h>
3. include <unistd.h>
4. include <sys/types.h>
5. include <fcntl.h>
6. include <sys/stat.h>

// Letter lookup by frequency. This is to reduce word insertion time. const char *freq = "zqxjkvbpygfwmucldrhsnioate"; int char_to_idx[128];

// Trie structure of sorts struct word { const char *w; struct word *next; };

union node { union node *down[10]; struct word *list[10]; };

int deranged(const char *s1, const char *s2) { int i; for (i = 0; s1[i]; i++) if (s1[i] == s2[i]) return 0; return 1; }

int count_letters(const char *s, unsigned char *c) { int i, len; memset(c, 0, 26); for (len = i = 0; s[i]; i++) { if (s[i] < 'a' || s[i] > 'z') return 0; len++, c[char_to_idx[(unsigned char)s[i]]]++; } return len; }

const char * insert(union node *root, const char *s, unsigned char *cnt) { int i; union node *n; struct word *v, *w = 0;

for (i = 0; i < 25; i++, root = n) { if (!(n = root->down[cnt[i]])) root->down[cnt[i]] = n = calloc(1, sizeof(union node)); }

w = malloc(sizeof(struct word)); w->w = s; w->next = root->list[cnt[25]]; root->list[cnt[25]] = w;

for (v = w->next; v; v = v->next) { if (deranged(w->w, v->w)) return v->w; } return 0; }

int main(int c, char **v) { int i, j = 0; char *words; struct stat st;

int fd = open(c < 2 ? "unixdict.txt" : v[1], O_RDONLY); if (fstat(fd, &st) < 0) return 1;

words = malloc(st.st_size); read(fd, words, st.st_size); close(fd);

union node root = Template:0; unsigned char cnt[26]; int best_len = 0; const char *b1, *b2;

for (i = 0; freq[i]; i++) char_to_idx[(unsigned char)freq[i]] = i;

/* count words, change newline to null */ for (i = j = 0; i < st.st_size; i++) { if (words[i] != '\n') continue; words[i] = '\0';

if (i - j > best_len) { count_letters(words + j, cnt); const char *match = insert(&root, words + j, cnt);

if (match) { best_len = i - j; b1 = words + j; b2 = match; } }

j = ++i; }

if (best_len) printf("longest derangement: %s %s\n", b1, b2);

return 0; }</lang>

Output:

longest derangement: intoxicate excitation

C++

<lang cpp>#include <algorithm>

1. include <fstream>
2. include <functional>
3. include <iostream>
4. include <map>
5. include <numeric>
6. include <set>
7. include <string>

bool is_deranged(const std::string& left, const std::string& right) {

   return (left.size() == right.size()) &&
       (std::inner_product(left.begin(), left.end(), right.begin(), 0, std::plus<int>(), std::equal_to<char>()) == 0);

}

int main() {

   std::ifstream input("unixdict.txt");
   if (!input) {
       std::cerr << "can't open input file\n";
       return EXIT_FAILURE;
   }

   typedef std::set<std::string> WordList;
   typedef std::map<std::string, WordList> AnagraMap;
   AnagraMap anagrams;

   std::pair<std::string, std::string> result;
   size_t longest = 0;

   for (std::string value; input >> value; /**/) {
       std::string key(value);
       std::sort(key.begin(), key.end());

       if (longest < value.length()) { // is it a long candidate?
           if (0 < anagrams.count(key)) { // is it an anagram?
               for (const auto& prior : anagrams[key]) {
                   if (is_deranged(prior, value)) { // are they deranged?
                       result = std::make_pair(prior, value);
                       longest = value.length();
                   }
               }
           }
       }
       anagrams[key].insert(value);
   }

   std::cout << result.first << ' ' << result.second << '\n';
   return EXIT_SUCCESS;

}</lang>

Output:

excitation intoxicate

Clojure

<lang Clojure>(let

 [words    (re-seq #"\w+" (slurp "unixdict.txt"))
  anagrams (filter second (vals (group-by sort words)))
  deranged (remove #(some true? (apply map = %)) anagrams)]
 (prn (last (sort-by #(count (first %)) deranged))))</lang>

Output:

$ lein exec deranged.clj
["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

Shorter Version

<lang d>void main() {

   import std.stdio, std.file, std.algorithm, std.string, std.range,
          std.functional, std.exception;

   string[][const ubyte[]] anags;
   foreach (const w; "unixdict.txt".readText.split)
       anags[w.dup.representation.sort().release.assumeUnique] ~= w;

   anags
   .byValue
   .map!(words => cartesianProduct(words, words)
                  .filter!(ww => ww[].equal!q{ a != b })
                  .array)
   .filter!(not!empty)
   .array
   .schwartzSort!q{ a[0][0].length }
   .back[0]
   .writeln;

}</lang>

Output:

Tuple!(string, string)("intoxicate", "excitation")

Runtime: about 0.12 seconds.

Faster Version

<lang d>import std.stdio, std.file, std.algorithm, std.string, std.array,

      std.functional, std.exception;

string[2][] findDeranged(in string[] words) pure nothrow {

   // return words.pairwise.filter!(ww => ww[].equal!q{ a != b });
   typeof(return) result;
   foreach (immutable i, w1; words)
       foreach (w2; words[i + 1 .. $])
           if (w1.representation.equal!q{ a != b }(w2.representation))
               result ~= [w1, w2];
   return result;

}

void main() {

   Appender!(string[])[30] wClasses;
   foreach (const w; "unixdict.txt".readText.splitter)
       wClasses[$ - w.length] ~= w;

   foreach (const ws; wClasses[].map!q{ a.data }.filter!(not!empty)) {
       string[][const ubyte[]] anags; // Assume ASCII input.
       foreach (immutable w; ws)
           anags[w.dup.representation.sort().release.assumeUnique]~= w;
       auto pairs = anags.byValue.map!findDeranged.joiner;
       if (!pairs.empty)
           return writefln("Longest deranged: %-(%s %)", pairs.front);
   }

}</lang>

Output:

Longest deranged: excitation intoxicate

Runtime: about 0.03 seconds.

Erlang

Using anagrams:fetch/2 from Anagrams and init_http/0 from Rosetta_Code/Find_unimplemented_tasks. Exporting words_from_url/1 to Ordered_words. <lang Erlang> -module( anagrams_deranged ). -export( [task/0, words_from_url/1] ).

task() ->

      find_unimplemented_tasks:init_http(),
      Words = words_from_url( "http://www.puzzlers.org/pub/wordlists/unixdict.txt" ),
      Anagram_dict = anagrams:fetch( Words, dict:new() ),
      Deranged_anagrams = deranged_anagrams( Anagram_dict ),
      {_Length, Longest_anagrams} = dict:fold( fun keep_longest/3, {0, []}, Deranged_anagrams ),
      Longest_anagrams.

words_from_url( URL ) -> {ok, {{_HTTP, 200, "OK"}, _Headers, Body}} = httpc:request( URL ), string:tokens( Body, "\n" ).

deranged_anagrams( Dict ) ->

       Deranged_dict = dict:map( fun deranged_words/2, Dict ),
       dict:filter( fun is_anagram/2, Deranged_dict ).

deranged_words( _Key, [H | T] ) ->

       [{H, X} || X <- T, is_deranged_word(H, X)].

keep_longest( _Key, [{One, _} | _]=New, {Length, Acc} ) ->

       keep_longest_new( erlang:length(One), Length, New, Acc ).

keep_longest_new( New_length, Acc_length, New, _Acc ) when New_length > Acc_length ->

       {New_length, New};

keep_longest_new( New_length, Acc_length, New, Acc ) when New_length =:= Acc_length ->

       {Acc_length, Acc ++ New};

keep_longest_new( _New_length, Acc_length, _New, Acc ) ->

       {Acc_length, Acc}.

is_anagram( _Key, [] ) -> false; is_anagram( _Key, _Value ) -> true.

is_deranged_word( Word1, Word2 ) ->

       lists:all( fun is_deranged_char/1, lists:zip(Word1, Word2) ).

is_deranged_char( {One, Two} ) -> One =/= Two. </lang>

Output:

8> anagrams_deranged:task().
[{"excitation","intoxicate"}]

Factor

<lang factor>USING: assocs fry io.encodings.utf8 io.files kernel math math.combinatorics sequences sorting strings ; IN: rosettacode.deranged-anagrams

derangement? ( str1 str2 -- ? ) [ = not ] 2all? ;

derangements ( seq -- seq )

   2 [ first2 derangement? ] filter-combinations ;

parse-dict-file ( path -- hash )

   utf8 file-lines 
   H{ } clone [
       '[ 
           [ natural-sort >string ] keep
           _ [ swap suffix  ] with change-at
       ] each
   ] keep ;

anagrams ( hash -- seq ) [ nip length 1 > ] assoc-filter values ;

deranged-anagrams ( path -- seq )

   parse-dict-file anagrams [ derangements ] map concat ;

longest-deranged-anagrams ( path -- anagrams )

   deranged-anagrams [ first length ] sort-with last ;</lang>

   "unixdict.txt" 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;

1. 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;

1. 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);

1. [ [ "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

Works with: Java version 7

<lang java>import java.io.*; import java.util.*;

public class DerangedAnagrams {

   public static void main(final String[] args) throws IOException {
       if (!findAnagrams(readLines("unixdict.txt")))
           System.out.println("no result");
   }

   private static boolean isDeranged(final String w, final List<String> lst) {
       for (String w2 : lst) {
           int k = w.length() - 1;
           while (k >= 0 && w.charAt(k) != w2.charAt(k)) {
               k--;
           }
           if (k == -1) {
               System.out.println(w + ", " + w2);
               return true;
           }
       }
       return false;
   }

   private static boolean findAnagrams(final List<String> words) {
       Collections.sort(words, new Comparator<String>() {
           public int compare(String a, String b) {
               return b.length() - a.length();
           }
       });
       Map<String, ArrayList<String>> map = new HashMap<>();
       for (String w : words) {
           char[] srt = w.toCharArray();
           Arrays.sort(srt);
           String key = String.valueOf(srt);
           ArrayList<String> lst;
           if (map.containsKey(key)) {
               lst = map.get(key);
               if (isDeranged(w, lst)) {
                   return true;
               }
               lst.add(w);
           } else {
               lst = new ArrayList<>();
               lst.add(w);
               map.put(key, lst);
           }
       }
       return false;
   }

   private static List<String> readLines(final String fn) throws IOException {
       List<String> lines;
       try (BufferedReader br = new BufferedReader(new FileReader(fn))) {
           lines = new ArrayList<>();
           String line = null;
           while ((line = br.readLine()) != null)
               lines.add(line);
       }
       return lines;
   }

}</lang>

Output:

[excitation, intoxicate]

JavaScript

Spidermonkey

This example is a little long because it tries to emphasize generality and clarity over brevity.

<lang JavaScript>#!/usr/bin/env js

function main() {

   var wordList = read('unixdict.txt').split(/\s+/);
   var anagrams = findAnagrams(wordList);
   var derangedAnagrams = findDerangedAnagrams(anagrams);
   var longestPair = findLongestDerangedPair(derangedAnagrams);
   print(longestPair.join(' '));
   

}

function findLongestDerangedPair(danas) {

   var longestLen = danas[0][0].length;
   var longestPair = danas[0];
   for (var i in danas) {
       if (danas[i][0].length > longestLen) {
           longestLen = danas[i][0].length;
           longestPair = danas[i];
       }
   }
   return longestPair;

}

function findDerangedAnagrams(anagrams) {

   var deranged = [];
   
   function isDeranged(w1, w2) {
       for (var c = 0; c < w1.length; c++) {
           if (w1[c] == w2[c]) {
               return false;
           }
       }
       return true;
   }

   function findDeranged(anas) {
       for (var a = 0; a < anas.length; a++) {
           for (var b = a + 1; b < anas.length; b++) {
               if (isDeranged(anas[a], anas[b])) {
                   deranged.push([anas[a], anas[b]]);
               }   
           }
       }
   }
   
   for (var a in anagrams) {
       var anas = anagrams[a];
       findDeranged(anas);
   }
   
   return deranged;

}

function findAnagrams(wordList) {

   var anagrams = {};

   for (var wordNum in wordList) {
       var word = wordList[wordNum];
       var key = word.split().sort().join();
       if (!(key in anagrams)) {
           anagrams[key] = [];
       }
       anagrams[key].push(word);
   }

   for (var a in anagrams) {
       if (anagrams[a].length < 2) {
           delete(anagrams[a]);
       }
   }

   return anagrams;

}

main();

</lang>

Output:

excitation intoxicate

Gecko

This example does not show the output mentioned in the task description on this page (or a page linked to from here). Please ensure that it meets all task requirements and remove this message. Note that phrases in task descriptions such as "print and display" and "print and show" for example, indicate that (reasonable length) output be a part of a language's solution.

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>

Lasso

<lang Lasso>local( anagrams = map, words = include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt') -> split('\n'), key, max = 0, wordsize, findings = array, derangedtest = { // this code snippet is not executed until the variable is invoked. It will return true if the compared words are a deranged anagram local( w1 = #1, w2 = #2, testresult = true )

loop(#w1 -> size) => { #w1 -> get(loop_count) == #w2 -> get(loop_count) ? #testresult = false } return #testresult } )

// find all anagrams with word in #words do { #key = #word -> split() -> sort& -> join() not(#anagrams >> #key) ? #anagrams -> insert(#key = array) #anagrams -> find(#key) -> insert(#word) }

// step thru each set of anagrams to find deranged ones with ana in #anagrams let ana_size = #ana -> size where #ana_size > 1 do { #wordsize = #ana -> first -> size

if(#wordsize >= #max) => {

loop(#ana_size - 1) => { if(#derangedtest -> detach & invoke(#ana -> get(loop_count), #ana -> get(loop_count + 1))) => { // we only care to save the found deranged anagram if it is longer than the previous longest one if(#wordsize > #max) => { #findings = array(#ana -> get(loop_count) + ', ' + #ana -> get(loop_count + 1)) else #findings -> insert(#ana -> get(loop_count) + ', ' + #ana -> get(loop_count + 1)) } #max = #wordsize } }

} }

1. findings -> join('
   \n')</lang>

Result -> excitation, intoxicate

Liberty BASIC

<lang lb>print "Loading dictionary file." open "unixdict.txt" for input as #1 a$=input$(#1,lof(#1)) close #1

dim theWord$(30000) dim ssWord$(30000)

c10$ = chr$(10) i = 1 print "Creating array of words." 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 print "Checking for deranged anagrams." 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 theWord$(maxPtrI);" => ";theWord$(maxPtrJ) end </lang>

Output:

excitation => intoxicate

Mathematica

<lang Mathematica> words=First/@Import["http://www.puzzlers.org/pub/wordlists/unixdict.txt","Table"]; anagramDegrangement=Function[{w1,w2}, Module[{c1=ToCharacterCode@w1,c2=ToCharacterCode@w2}, Sort@c1==Sort@c2&&Select[c1-c2,#==0&,1]==={}]]; gs=Select[GatherBy[words,{StringLength@#,Union@ToCharacterCode@#}&],Length@#>=2&]; First@Flatten[Function[ws,Select[Join@@Outer[List,ws,ws,1],anagramDegrangement@@#&]]/@SortBy[gs,-StringLength@First@#&],1] </lang> Output:

{"excitation", "intoxicate"}

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.replace 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

ooRexx

<lang ooRexx> -- This assumes you've already downloaded the following file and placed it -- in the current directory: http://www.puzzlers.org/pub/wordlists/unixdict.txt

-- There are several different ways of reading the file. I chose the -- supplier method just because I haven't used it yet in any other examples. source = .stream~new('unixdict.txt')~supplier -- this holds our mappings of the anagrams. This is good use for the -- relation class anagrams = .relation~new count = 0 -- this is used to keep track of the maximums

loop while source~available

   word = source~item
   -- this produces a string consisting of the characters in sorted order
   -- Note: the ~~ used to invoke sort makes that message return value be
   -- the target array.  The sort method does not normally have a return value.
   key = word~makearray()~~sort~tostring("l", "")
   -- add this to our mapping.  This creates multiple entries for each
   -- word that uses the same key
   anagrams[key] = word
   source~next

end

-- now get the set of unique keys keys = .set~new~~putall(anagrams~allIndexes) -- the longest count tracker longest = 0 -- our list of the longest pairs pairs = .array~new

loop key over keys

   -- don't even bother doing the deranged checks for any key
   -- shorter than our current longest
   if key~length < longest then iterate

   words = anagrams~allAt(key)
   -- singletons aren't anagrams at all
   newCount = words~items
   loop i = 1 to newCount - 1
       word1 = words[i]
       loop j = 1 to newCount
           word2 = words[j]
           -- bitxor will have '00'x in every position where these
           -- strings match.  If found, go around and check the
           -- next one
           if word1~bitxor(word2)~pos('00'x) > 0 then iterate
           -- we have a match
           else do
               if word1~length > longest then do
                   -- throw away anything we've gathered so far
                   pairs~empty
                   longest = word1~length
               end
               pairs~append(.array~of(word1, word2))
           end
       end
   end

end

say "The longest deranged anagrams we found are:" loop pair over pairs

    say pair[1] pair[2]

end </lang> Output:

The longest deranged anagrams we found are:
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

Works with: SWI 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

1. True = 1
2. 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

Translation of: D

<lang python>from itertools import izip, ifilter from collections import defaultdict

def find_deranged(words):

   return [(w1, w2) for i, w1 in enumerate(words)
                    for w2 in words[i + 1:]
                    if all(a != b for a,b in izip(w1, w2))]

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>

Racket

<lang racket>#lang racket (define word-list-file "data/unixdict.txt")

(define (read-words-into-anagram-keyed-hash)

 (define (anagram-key word) (sort (string->list word) char<?))
 (for/fold ((hsh (hash)))
   ((word (in-lines)))
   (hash-update hsh (anagram-key word) (curry cons word) null)))

(define anagrams-list

 (sort
  (for/list
      ((v (in-hash-values
           (with-input-from-file
               word-list-file
             read-words-into-anagram-keyed-hash)))
       #:when (> (length v) 1)) v)
  > #:key (compose string-length first)))

(define (deranged-anagram-pairs l (acc null))

 (define (deranged-anagram-pair? hd tl)
   (define (first-underanged-char? hd tl)
     (for/first
         (((c h) (in-parallel hd tl))
          #:when (char=? c h)) c))  
   (not (first-underanged-char? hd tl)))
 
 (if (null? l) acc
     (let ((hd (car l)) (tl (cdr l)))
       (deranged-anagram-pairs
        tl
        (append acc (map (lambda (x) (list hd x))
                         (filter (curry deranged-anagram-pair? hd) tl)))))))

for*/first give the first set of deranged anagrams (as per the RC problem)

for*/list gives a full list of the sets of deranged anagrams (which might be interesting)

(for*/first

   ((anagrams (in-list anagrams-list))
    (daps (in-value (deranged-anagram-pairs anagrams)))
    #:unless (null? daps))
 daps)</lang>

Output:

'(("intoxicate" "excitation"))

REXX

<lang rexx>/*REXX program finds the largest deranged word (within a dictionary).*/ ifid='unixdict.txt'; words=0 /*input file identifier, # words.*/ wL.=0 /*number of words of length L. */

     do j=1  while lines(ifid)\==0    /*read each word in file (word=X)*/
     x=space(linein(ifid),0)          /*pick off a word from the input.*/
     L=length(x); if L<3 then iterate /*onesies and twosies can't win. */
     words=words+1                    /*count of (useable) words.      */
     #.words=L                        /*the length of the word found.  */
     @.words=x                        /*save the word in an array.     */
     wL.L=wL.L+1;        _=wL.L       /*counter of words of length  L. */
     @@.L._=x                         /*array   of words of length  L. */
        /*sort the letters*/   do ja=1 for L;   !.ja=substr(x,ja,1);  end
     !.0=L; call esort;z=;     do jb=1 for L;   z=z || !.jb;          end
     @@s.L._=z                        /*store the sorted word (letters)*/
     @s.words=@@s.L._                 /*and also, sorted length L vers.*/
     end   /*j*/

a.= /*all the anagrams for word X. */ say copies('─',30) words 'words in the dictionary file: ' ifid m=0; n.=0 /*# anagrams for word X; m=max L.*/

      do j=1  for words               /*process the usable words found.*/
      x=@.j;     Lx=#.j;   xs=@s.j    /*get some vital statistics for X*/
      if m\==0 & Lx<m then iterate    /*bypass comparisons if too short*/
        do k=1  for wL.Lx             /*process all the words of len L.*/
        if xs\==@@s.Lx.k then iterate /*is this a true anagram of  X ? */
        if x  ==@@.Lx.k  then iterate /*skip doing anagram on itself.  */
           do c=1 for Lx              /*ensure no character pos shared.*/
           if substr(@.j,c,1)==substr(@@.Lx.k,c,1)  then iterate k
           end      /*c*/
        n.j=n.j+1;  a.j=a.j  @@.Lx.k  /*bump counter, add ──► anagrams.*/
        m=max(m,Lx)                   /*M is the maximum length of word*/
        end         /*k*/
      end           /*j*/

 do k=1  for words                    /*now, search all words for max. */
 if #.k==m   then if n.k\==0   then if word(a.k,1)>@.k   then say @.k a.k
 end   /*k*/                          /*above:REXX has no shortcircuits*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────ESORT───────────────────────────────*/ esort:procedure expose !.;h=!.0;do while h>1;h=h%2;do i=1 for !.0-h;j=i;k=h+i do while !.k<!.j;t=!.j;!.j=!.k;!.k=t;if h>=j then leave;j=j-h;k=k-h;end;end;end;return</lang> output when using the default dictionary

────────────────────────────── 24945 words in the dictionary file:  unixdict.txt
excitation  intoxicate

Ruby

<lang ruby>require 'open-uri' anagram = open('http://www.puzzlers.org/pub/wordlists/unixdict.txt') do |f|

 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 find_derangements(list)

 for i in 0 ... list.size-1
   for j in i ... list.size
     return list[i], list[j]  if deranged?(list[i], list[j])
   end
 end
 nil

end

anagram = anagram.select{|k,list| list.size>1}.sort_by{|k,list| -k.size}

anagram.each do |k,list|

 derangements = find_derangements(list)
 if derangements
   puts "derangement with longest word size: #{derangements}"
   break
 end

end</lang>

Output:

derangement with longest word size: ["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

1. 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

1. Group by characters in word

foreach word $wordlist {

   dict lappend w [lsort [split $word ""]] [split $word ""]

}

1. Deranged test

proc deranged? {l1 l2} {

   foreach c1 $l1 c2 $l2 {

if {$c1 eq $c2} {return 0}

   }
   return 1

}

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}

}

1. 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 ""]

   }

}

1. 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 ==

1. 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+-

1. cast %sW

main = longest_deranged_anagram unixdict_dot_txt</lang>

Output:

('excitation','intoxicate')