Anagrams/Deranged anagrams: Difference between revisions

By analogy with [[Permutations/Derangements|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.

 

 

Use the word list at [http://wiki.puzzlers.org/pub/wordlists/unixdict.txt unixdict] to find and display the longest deranged anagram.

 

 

* [[Permutations/Derangements]]

* [[Best_shuffle|Best shuffle]]

=={{header|11l}}==

{{trans|Kotlin}}

L(i) 0 .< s1.len

I s1[i] == s2[i]

V count = 0

L(word) File(‘unixdict.txt’).read().split("\n")

I a !C anagram

anagram[a] = [word]

L(ana) anagram.values()

I ana.len > 1 & ana[0].len == count

{{out}}

<pre>[excitation, intoxicate]</pre>

=={{header|AArch64 Assembly}}==

{{works with|as|Raspberry Pi 3B version Buster 64 bits <br> or android 64 bits with application Termux }}

/* ARM assembly AARCH64 Raspberry PI 3B */

/* program anaderan64.s */

.include "../includeARM64.inc"

 

<pre>

Program 64 bits start.

=={{header|Ada}}==

{{Works with|Ada 2005}}

with Ada.Containers.Generic_Array_Sort;

with Ada.Containers.Indefinite_Vectors;

Close (File);

Put_Line (Vect.Element (p1) & " " & Vect.Element (p2));

{{out}}

<pre>intoxicate excitation</pre>

=={{header|ALGOL 68}}==

{{works with|ALGOL 68G|Any - tested with release 2.8.3.win32}} Uses the "read" PRAGMA of Algol 68 G to include the associative array code from the [[Associative_array/Iteration]] task.

# use the associative array in the Associate array/iteration task #

PR read "aArray.a68" PR

)

)

{{out}}

<pre>

 

=={{header|AppleScript}}==

 

 

on longestDerangedAnagrams(listOfWords)

script o

property wordList : listOfWords

property output : {}

-- Test for any deranged pairs amongst the words of an anagram group.

on testPairs(a, b)

set wordLength to (count beginning of anagramGroup)

set areDeranged to true

repeat with c from 1 to wordLength

set areDeranged to false

exit repeat

end if

end repeat

if (areDeranged) then

end if

end repeat

end repeat

end testPairs

end script

ignoring case

end repeat

set i to 1

if (thisText is not currentText) then

if (j - i > 1) then tell o to testPairs(i, j - 1)

set i to j

end if

end repeat

if (j > i) then tell o to testPairs(i, j)

end longestDerangedAnagrams

 

local wordFile, wordList

set wordList to paragraphs of (read wordFile as «class utf8»)

 

{{output}}

=={{header|ARM Assembly}}==

{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}

/* ARM assembly Raspberry PI */

/* program anaderan.s */

/***************************************************/

.include "../affichage.inc"

<pre>

Program 32 bits start.

=={{header|Arturo}}==

 

[a,b]: p

loop 0..dec size a 'i [

]

 

 

{{out}}

 

=={{header|AutoHotkey}}==

SetWorkingDir %A_ScriptDir% ; Ensures a consistent starting directory.

SetBatchLines -1

}

old1 := no_let1, old2 := A_Loopfield

{{out}}

<pre>

{{works with|GNU awk (gawk) 3.1.5}}

 

BEGIN{

FS=""

if (length(found) > 0) exit

}

On my system, this awk-file is located at /usr/local/bin/deranged,

so it can be invoked with:

 

Regular invocation would be:

{{out}}

<pre>

</pre>

 

 

FUNCTION Deranged(a$, b$)

PRINT "Maximum deranged anagrams: ", an1$, " and ", an2$

 

{{out}}

<pre>

</pre>

 

{{works with|BBC BASIC for Windows}}

Sort% = FN_sortinit(0,0)

$$^a&(0) = A$

CALL Sort%, a&(0)

{{out}}

<pre>

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.

& 1:?product

& :?unsorted

* ?

| out$!derangedAnagrams

{{out}}

<pre>excitation.intoxicate</pre>

 

=={{header|C}}==

#include <stdlib.h>

#include <string.h>

 

return 0;

{{out}}

<pre>

{{libheader|System.IO}}

{{works with|C sharp|6}}

{

var lookupTable = File.ReadLines("unixdict.txt").ToLookup(line => AnagramKey(line));

&& Enumerable.Range(0, first.Length).All(i => first[i] != second[i])

select new [] { first, second })

{{out}}

<pre>

 

=={{header|C++}}==

#include <fstream>

#include <functional>

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

return EXIT_SUCCESS;

{{out}}

<pre>

 

=={{header|Clojure}}==

(re-seq #"\w+") ; |

(group-by sort) ; anagrams

(sort-by #(count (first %)))

last

{{out}}

<pre>$ lein exec deranged.clj

 

=={{header|COBOL}}==

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

=={{header|CoffeeScript}}==

This example was tested with node.js.

 

is_derangement = (word1, word2) ->

req.end()

{{out}}

<pre>

 

=={{header|Common Lisp}}==

(with-open-file (stream file)

(loop with w = "" while w collect (setf w (read-line stream nil)))))

(setf (gethash ws h) (cons w l))))))

 

{{out}}

<pre>intoxicate

=={{header|D}}==

===Short Version===

import std.stdio, std.file, std.algorithm, std.string, std.array;

 

.minPos!q{ a[0].length > b[0].length }[0]

.writeln;

{{out}}

<pre>Tuple!(string, string)("intoxicate", "excitation")</pre>

 

Using const(ubytes)[] instead of dstrings gives a runtime of about 0.07 seconds:

foreach (const w; "unixdict.txt".readText.split)

 

===Faster Version===

std.functional, std.exception;

 

return writefln("Longest deranged: %-(%s %)", pairs.front);

}

{{out}}

<pre>Longest deranged: excitation intoxicate</pre>

{{libheader| System.Classes}}

{{libheader| System.Diagnostics}}

 

{$APPTYPE CONSOLE}

Dict.Free;

Readln;

 

{{out}}

=={{header|EchoLisp}}==

For a change, we use the french dictionary included in EchoLisp package.

(lib 'struct)

(lib 'sql)

(write lmin) (for-each write lw)

(writeln)))

{{out}}

(lib 'dico.fr.no-accent) ;; 209315 words into *words* table

(task)

14 charlatanistic antarchistical

15 megachiropteran cinematographer

 

=={{header|Eiffel}}==

ANAGRAMS_DERANGED

 

words: HASH_TABLE [LINKED_LIST [STRING], STRING]

 

{{out}}

<pre>

=={{header|Elixir}}==

{{trans|Ruby}}

def deranged(fname) do

File.read!(fname)

{_, words} -> IO.puts "Longest derangement anagram: #{inspect words}"

_ -> IO.puts "derangement anagram: nothing"

 

{{out}}

=={{header|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]].

-export( [task/0, words_from_url/1] ).

 

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

 

{{out}}

<pre>

 

=={{header|F_Sharp|F#}}==

 

let keyIsSortedWord = Seq.sort >> Seq.toArray >> String

|> snd

|> printfn "%A"

{{out}}

<pre>[("excitation", "intoxicate")]</pre>

 

=={{header|Factor}}==

math.combinatorics sequences sorting strings ;

IN: rosettacode.deranged-anagrams

 

: longest-deranged-anagrams ( path -- anagrams )

 

"unixdict.txt" longest-deranged-anagrams .

 

=={{header|FreeBASIC}}==

 

Type IndexedWord

Print

Print "Press any key to quit"

 

{{out}}

Took 0.089 seconds on i3 @ 2.13 GHz

</pre>

 

=={{header|GAP}}==

Using function [[Anagrams#GAP|Anagrams]].

local i, n;

for i in [1 .. Size(a)] do

n := Maximum(List(a, x -> Size(x[1])));

Filtered(a, x -> Size(x[1]) = n);

 

=={{header|Go}}==

import (

"fmt"

 

fmt.Println(w1, w2, ": Length", best_len)

{{out}}

<pre>

=={{header|Groovy}}==

Solution:

 

new URL('http://www.puzzlers.org/pub/wordlists/unixdict.txt').eachLine { word ->

} else {

println 'Deranged anagrams are a MYTH!'

 

{{out}}

=={{header|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.

 

import Data.List (maximumBy, sort, unfoldr)

case maxDerangedAnagram $ words input of

Nothing -> putStrLn "No deranged anagrams were found."

{{out}}

<pre>Longest deranged anagrams: excitation and intoxicate</pre>

 

=={{header|Icon}} and {{header|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).

 

procedure main()

every i := 1 to *s1 do if s1[i] == s2[i] then fail

return [s1,s2]

{{out|Sample run}}

<pre>->dra <unixdict.txt

=={{header|J}}==

This assumes that [http://www.puzzlers.org/pub/wordlists/unixdict.txt unixdict.txt] has been saved in the current directory.

25104

#anagrams=: (#~ 1 < #@>) (</.~ /:~&>) words

││excitation│intoxicate││

│└──────────┴──────────┘│

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 <code>maybederanged=: (#~ (-: ~."1)@|:@:>&>) anagrams</code>

 

=={{header|Java}}==

{{works with|Java|8}}

import java.io.IOException;

import java.nio.file.Files;

return true;

}

{{out}}

<pre>excitation intoxicate</pre>

brevity.

 

 

function main() {

}

 

 

{{out}}

=== Gecko ===

Word file is saved locally because browser won't fetch it cross-site. Tested on Gecko.

<body><pre id='x'></pre>

<script type="application/javascript">

 

show(best_pair);

 

{{Out|Output (in a browser window)}}

This solution allows for the possibility of more than one answer.

 

# Output: a stream of arrays

def anagrams:

else .

end) ) )

 

'''Invocation and output'''

=={{header|Julia}}==

 

# Let's define the less than operator for any two vectors that have the same type:

# This does lexicographic comparison, we use it on vectors of chars in this task.

break

end

 

{{out}}

 

=={{header|K}}==

a:{x g@&1<#:'g:={x@<x}'x}@0:"unixdict.txt";

b@&c=|/c:{#x[0]}'b:a@&{0=+//{x=y}':x}'a

("excitation"

 

=={{header|Kotlin}}==

 

import java.io.BufferedReader

.filter { it.size > 1 && it[0].length == count }

.forEach { println(it) }

 

{{out}}

 

=={{header|Lasso}}==

anagrams = map,

words = include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt') -> split('\n'),

}

 

 

Result -> excitation, intoxicate

 

=={{header|Liberty BASIC}}==

open "unixdict.txt" for input as #1

a$=input$(#1,lof(#1))

 

print theWord$(maxPtrI);" => ";theWord$(maxPtrJ)

{{out}}

excitation => intoxicate

 

=={{header|Lua}}==

local arr={}

for ch in str:gmatch(".") do arr[#arr+1]=ch end

end

end

{{out}}

<pre>excitation intoxicate 10</pre>

 

=={{header|Maple}}==

dict:=Split([HTTP:-Get("www.puzzlers.org/pub/wordlists/unixdict.txt")][2]):

L:=[seq(select(t->HammingDistance(t,w)=length(w),[Anagrams(w,dict)])[],w=dict)]:

len:=length(ListTools:-FindMaximalElement(L,(a,b)->length(a)<length(b))):

{{out}}

<pre>

 

=={{header|Mathematica}} / {{header|Wolfram Language}}==

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&];

{{out}}

<pre>

 

A similar approach using Mathematica 10:

MaximalBy[

Select[GatherBy[list, Sort@*Characters],

Length@# > 1 && And @@ MapThread[UnsameQ, Characters /@ #] &],

 

{{out}}

 

=={{header|Nim}}==

import tables

import times

 

echo "Longest deranged anagram pair: ", best1, " ", best2

 

{{out}}

 

=={{header|OCaml}}==

let r = String.copy s in

for i = 0 to (String.length r) - 2 do

) ([], 0) lst

in

{{out}}

<pre>$ ocaml deranged_anagram.ml

 

=={{header|ooRexx}}==

-- in the current directory: http://www.puzzlers.org/pub/wordlists/unixdict.txt

 

loop pair over pairs

say pair[1] pair[2]

{{out}}

<pre>

 

=={{header|PARI/GP}}==

len=apply(s->#s, dict);

getLen(L)=my(v=List()); for(i=1,#dict, if(len[i]==L, listput(v, dict[i]))); Vec(v);

getDeranged(v)=my(u=List(),w); for(i=1,#v-1, for(j=i+1,#v, if(deranged(v[i], v[j]), listput(u, [v[i], v[j]])))); Vec(u);

f(n)=my(t=getAnagrams(getLen(n))); if(#t, concat(apply(getDeranged, t)), []);

{{out}}

<pre>%1 = [["excitation", "intoxicate"]]</pre>

Using extra Stringlist for sorted by character words and insertion sort.<BR>

Runtime 153 ms -> 35 ms (Free Pascal Compiler version 3.3.1-r20:47268 [2020/11/02] for x86_64)

{$IFDEF FPC}

{$MODE Delphi}

Dict.Free;

end.

{{out}}

<pre>

 

=={{header|Perl}}==

my @a = split('', shift); # split word into letters

my @b = split('', shift);

keys %letter_list )

{

last if find_deranged(@{ $letter_list{$_} });

{{out}}

use warnings;

 

local (@ARGV, $/) = 'unixdict.txt';

{

my $key = join '', sort +split //, $word;

push @{ $anagrams{$key} }, $word;

{{out}}

 

=={{header|Phix}}==

<span style="color: #008080;">function</span> <span style="color: #000000;">deranged</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">word1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">word2</span><span style="color: #0000FF;">)</span>

<span style="color: #008080;">return</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sq_eq</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">word2</span><span style="color: #0000FF;">))=</span><span style="color: #000000;">0</span>

<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>

<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>

{{out}}

<pre>

excitation, intoxicate

</pre>

 

=={{header|PHP}}==

$words = file(

'http://www.puzzlers.org/pub/wordlists/unixdict.txt',

echo implode(" ", $final_word), "\n";

}

{{out}}

<pre>

 

=={{header|Picat}}==

M = [W:W in read_file_lines("unixdict.txt")].group(sort),

Deranged = [Value : _Key=Value in M, Value.length > 1, allderanged(Value)],

end,

IsDeranged == 1.

 

% Groups the element in List according to the function F

V = apply(F,E),

P.put(V, P.get(V,[]) ++ [E])

 

<pre>[[excitation,intoxicate]]</pre>

 

=={{header|PicoLisp}}==

(in "unixdict.txt"

(while (line)

(cons (pack @) (pack Lst)) ) )

(val Key) ) )

{{out}}

<pre>-> ("excitation" . "intoxicate")</pre>

 

=={{header|PowerShell}}==

{

$array1 = $Strings[0].ToCharArray()

Length = $deranged[0].Length

Words = $deranged

{{Out}}

<pre>

=={{header|Prolog}}==

{{Works with|SWI Prolog}}

http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt',In,[]),

read_file(In, [], Out),

msort(W, W1),

atom_codes(A, W1),

{{out}}

<pre> ?- longest_deranged_anagram.

 

=={{header|PureBasic}}==

word.s

letters.s

Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()

CloseConsole()

{{out}}

<pre>Largest 'Deranged' anagrams found are of length 10:

 

=={{header|Python}}==

from collections import defaultdict

from itertools import combinations

print("Longest anagrams with no characters in the same position:")

print(' ' + '\n '.join(', '.join(pairs)

{{out}}

<pre>Word count: 25104

 

Append the following to the previous code:

ordered_anagrams = sorted(anagrams.items(),

key=lambda x:(-len(x[0]), x[0]))

for pairs in most:

print()

 

{{out}}

 

===Python: Faster Version===

from itertools import combinations

from pathlib import Path

 

if __name__ == '__main__':

{{out}}

<pre>The longest anagram is: excitation, intoxicate</pre>

=={{header|Quackery}}==

 

[ 2drop false ] done

over sort over sort != iff

temp take

sortwith [ 0 peek size swap 0 peek size > ]

 

{{out}}

 

=={{header|R}}==

 

longest.deranged.anagram <- function(dict=puzzlers.dict) {

}

}

 

{{out}}

 

a b

 

=={{header|Racket}}==

(define word-list-file "data/unixdict.txt")

 

(daps (in-value (deranged-anagram-pairs anagrams)))

#:unless (null? daps))

{{out}}

<pre>'(("intoxicate" "excitation"))</pre>

{{works with|Rakudo|2016.08}}

 

.map(*.comb.cache) # explode words into lists of characters

.classify(*.sort.join).values # group words with the same characters

}

}

 

{{out}}

 

=={{header|REXX}}==

iFID= 'unixdict.txt'; words=0 /*input file ID; number of words so far*/

wL.=0 /*number of words of length L. so far*/

do while h>1; h=h % 2; do i=1 for ho-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

{{out|output|text= &nbsp; when using the default dictionary:}}

<pre>

 

=={{header|Ring}}==

 

load "stdlib.ring"

astring = substr(astring,substr(astring,bstring)+len(string(sum)))

end

{{out}}

<pre>

 

=={{header|Ruby}}==

a.chars.zip(b.chars).all? {|char_a, char_b| char_a != char_b}

end

break

end

{{out}}

<pre>

 

=={{header|Run BASIC}}==

dim theWord$(30000)

dim ssWord$(30000)

 

print maxLen;" ";theWord$(maxPtrI);" => ";theWord$(maxPtrJ)

{{out}}

<pre>10 excitation => intoxicate</pre>

 

=={{header|Rust}}==

use std::cmp::Ordering;

use std::collections::HashMap;

Err(e) => panic!("Could not read words: {}",e)

}

{{out}}

<pre>excitation intoxicate</pre>

 

=={{header|Scala}}==

 

/** Returns a map of anagrams keyed by the sorted characters */

}

 

{{out}}

<pre>Longest deranged pair: excitation and intoxicate</pre>

=={{header|Scheme}}==

 

(scheme char)

(scheme cxr)

(cdr rem))))))))

 

 

{{out}}

 

=={{header|Sidef}}==

for i in (^a) {

for j in (i+1 .. a.end) {

}

 

{{out}}

<pre>length 10: excitation => intoxicate</pre>

 

=={{header|Simula}}==

BEGIN

 

OUTTEXT(VECT.ELEMENT(P1) & " " & VECT.ELEMENT(P2));

OUTIMAGE;

{{out}}

<pre>intoxicate excitation

 

=={{header|Tcl}}==

package require http

 

puts "considered candidate pairing: $pair"

}

{{out}}

<pre>

 

=={{header|TUSCRIPT}}==

requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt")

 

ENDLOOP

ENDLOOP

{{out}}

<pre>

=={{header|UNIX Shell}}==

{{works with|ksh93}}

typeset host=www.puzzlers.org

typeset page=/pub/wordlists/unixdict.txt

fi

done <word.list

{{out}}

<pre>10 - excitation intoxicate</pre>

=={{header|Ursala}}==

This solution assumes the file <code>unixdict.txt</code> is passed to the compiler as a command line parameter.

 

anagrams = |=tK33lrDSL2SL ~=&& ==+ ~~ -<&

#cast %sW

 

The <code>anagrams</code> 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.

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.

 

longest_deranged_anagram =

#cast %sW

 

{{out}}

<pre>

 

=={{header|VBA}}==

Dim ListeWords() As String, Book As String, i As Long, j As Long, tempLen As Integer, MaxLen As Integer, tempStr As String, IsDeranged As Boolean, count As Integer, bAnag As Boolean

Dim t As Single

DerangedAnagram = True

Lenght = Len(str1)

 

{{out}}

Lenght : 10

Time to compute : 97,00781 sec.</pre>

 

=={{header|Wren}}==

{{libheader|Wren-sort}}

 

// assumes w1 and w2 are anagrams of each other

for (words in deranged) {

if (words[0].count == most) System.print([words[0], words[1]])

 

{{out}}

 

=={{header|zkl}}==

File("unixdict.txt").read().pump(Void,'wrap(w){

w=w.strip(); key:=w.sort(); words[key]=words.find(key,T).append(w);

nws.filter(fcn(nws,max){ nws[0]==max },

nws.reduce(fcn(p,nws){ p.max(nws[0]) },0) )

{{out}}

<pre>

</pre>

Replace the center section with the following for smaller code (3 lines shorter!) that is twice as slow:

if(ws.len()>1){ // two or more anagrams

n:=ws[0].len(); // length of these anagrams

}

Void.Skip