Anagrams/Deranged anagrams: Difference between revisions
m
→{{header|Wren}}: Minor tidy
(add task to aarch64 assembly raspberry pi) |
m (→{{header|Wren}}: Minor tidy) |
||
(15 intermediate revisions by 13 users not shown) | |||
Line 5:
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.
;Task
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]]
Line 22:
=={{header|11l}}==
{{trans|Kotlin}}
<
L(i) 0 .< s1.len
I s1[i] == s2[i]
Line 31:
V count = 0
L(word) File(‘unixdict.txt’).read().split("\n")
V a = sorted(word
I a !C anagram
anagram[a] = [word]
Line 44:
L(ana) anagram.values()
I ana.len > 1 & ana[0].len == count
print(ana)</
{{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 }}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program anaderan64.s */
Line 518 ⟶ 519:
.include "../includeARM64.inc"
</syntaxhighlight>
<pre>
Program 64 bits start.
Line 525 ⟶ 526:
=={{header|Ada}}==
{{Works with|Ada 2005}}
<
with Ada.Containers.Generic_Array_Sort;
with Ada.Containers.Indefinite_Vectors;
Line 569 ⟶ 570:
Close (File);
Put_Line (Vect.Element (p1) & " " & Vect.Element (p2));
end Danagrams;</
{{out}}
<pre>intoxicate excitation</pre>
Line 575 ⟶ 576:
=={{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
Line 698 ⟶ 699:
)
)
FI</
{{out}}
<pre>
Line 705 ⟶ 706:
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later.
use sorter : script ¬
"Custom Iterative Ternary Merge Sort" -- <www.macscripter.net/t/timsort-and-nigsort/71383/3>
use scripting additions
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
on longestDerangedAnagrams(listOfWords)
script o
property wordList : listOfWords
property
property
property output : {}
-- Test for any deranged pairs amongst the words of an anagram group.
on testPairs(a, b)
set anagramGroup to my wordList's items a thru b
set
set wordLength to (count beginning of anagramGroup)
repeat with i from 1 to (
set w1 to anagramGroup's item i
repeat with j from (i + 1) to
set w2 to anagramGroup's item j
set areDeranged to true
repeat with c from 1 to wordLength
if (w1's character c
set areDeranged to false
exit repeat
end if
end repeat
-- Append any deranged pairs found to the output
if (areDeranged) then
set end of
set
end if
end repeat
end repeat
end testPairs
-- Custom comparison handler for the sort. Text a should go after text b if
-- it's the same length and has a greater lexical value or it's shorter than b.
-- (The lexical sort direction isn't really relevant. It's just to group equal texts.)
on isGreater(a, b)
set aLen to a's length
set bLen to b's length
if (aLen = bLen) then return (a > b) -- or (b < a)!
return (aLen < bLen)
end isGreater
end script
set wordCount to (count o's wordList)
ignoring case
--
set
tell sorter to sort(chrs, 1, -1, {})
set
end repeat
-- within lengths. Echo the moves in the original word list.
tell sorter to sort(o's groupingTexts, 1, wordCount, {comparer:o, slave:{o's wordList}})
--
set i to 1
set currentText to beginning of o's
repeat with j from 2 to (
set thisText to
if (thisText is not currentText) then
if (j - i > 1) then tell o to testPairs(i, j - 1)
Line 781 ⟶ 784:
set i to j
end if
-- Stop on reaching a
if ((count thisText) < o's
end repeat
if (j > i) then tell o to testPairs(i, j)
Line 790 ⟶ 793:
end longestDerangedAnagrams
local wordFile, wordList
set wordFile to ((path to desktop as text) & "www.rosettacode.org:unixdict.txt") as «class furl»
set wordList to paragraphs of (read wordFile as «class utf8»)
return longestDerangedAnagrams(wordList)</
{{output}}
<
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
/* program anaderan.s */
Line 1,229:
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
<pre>
Program 32 bits start.
excitation intoxicate
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="rebol">isDeranged?: function [p][
[a,b]: p
loop 0..dec size a 'i [
if a\[i] = b\[i] [return false]
]
return true
]
wordset: map read.lines relative "unixdict.txt" => strip
anagrams: #[]
loop wordset 'word [
anagram: sort to [:char] word
unless key? anagrams anagram ->
anagrams\[anagram]: new []
anagrams\[anagram]: anagrams\[anagram] ++ word
]
deranged: select values anagrams 'anagram [ 2 = size anagram]
maxDeranged: ["" ""]
loop deranged 'd [
if (size first d) > size first maxDeranged [
pair: @[first d, last d]
if isDeranged? pair [
maxDeranged: pair
]
]
]
print maxDeranged</syntaxhighlight>
{{out}}
<pre>excitation intoxicate</pre>
=={{header|AutoHotkey}}==
<
SetWorkingDir %A_ScriptDir% ; Ensures a consistent starting directory.
SetBatchLines -1
Line 1,290 ⟶ 1,331:
}
old1 := no_let1, old2 := A_Loopfield
}</
{{out}}
<pre>
Line 1,298 ⟶ 1,339:
{{works with|GNU awk (gawk) 3.1.5}}
<
BEGIN{
FS=""
Line 1,356 ⟶ 1,397:
if (length(found) > 0) exit
}
}</
On my system, this awk-file is located at /usr/local/bin/deranged,
so it can be invoked with:
Line 1,364 ⟶ 1,405:
Regular invocation would be:
<
{{out}}
<pre>
Line 1,370 ⟶ 1,411:
</pre>
=={{header|
==={{header|BaCon}}===
<syntaxhighlight lang="freebasic">DECLARE idx$ ASSOC STRING
FUNCTION Deranged(a$, b$)
Line 1,399 ⟶ 1,441:
PRINT "Maximum deranged anagrams: ", an1$, " and ", an2$
PRINT NL$, "Total time: ", TIMER, " msecs.", NL$</
{{out}}
<pre>
Line 1,407 ⟶ 1,449:
</pre>
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<
Sort% = FN_sortinit(0,0)
Line 1,461 ⟶ 1,503:
$$^a&(0) = A$
CALL Sort%, a&(0)
= $$^a&(0)</
{{out}}
<pre>
Line 1,487 ⟶ 1,529:
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
Line 1,549 ⟶ 1,591:
* ?
| out$!derangedAnagrams
);</
{{out}}
<pre>excitation.intoxicate</pre>
=={{header|C}}==
<
#include <stdlib.h>
#include <string.h>
Line 1,663 ⟶ 1,705:
return 0;
}</
{{out}}
<pre>
Line 1,675 ⟶ 1,717:
{{libheader|System.IO}}
{{works with|C sharp|6}}
<
{
var lookupTable = File.ReadLines("unixdict.txt").ToLookup(line => AnagramKey(line));
Line 1,694 ⟶ 1,736:
&& Enumerable.Range(0, first.Length).All(i => first[i] != second[i])
select new [] { first, second })
.FirstOrDefault();</
{{out}}
<pre>
Line 1,701 ⟶ 1,743:
=={{header|C++}}==
<
#include <fstream>
#include <functional>
Line 1,750 ⟶ 1,792:
std::cout << result.first << ' ' << result.second << '\n';
return EXIT_SUCCESS;
}</
{{out}}
<pre>
Line 1,757 ⟶ 1,799:
=={{header|Clojure}}==
<
(re-seq #"\w+") ; |
(group-by sort) ; anagrams
Line 1,765 ⟶ 1,807:
(sort-by #(count (first %)))
last
prn)</
{{out}}
<pre>$ lein exec deranged.clj
Line 1,771 ⟶ 1,813:
=={{header|COBOL}}==
{{Works with|X/Open COBOL}}
<syntaxhighlight
01
01
01
01
01
01
05 WS-LETTER1
01
01
SORT WT-RECORD ON DESCENDING KEY WT-WORD-LEN.
PERFORM 500-FIND-DERANGED.
STOP RUN.
PERFORM 150-READ-RECORD.
* bubble sort:
300-SORT-WORD.
PERFORM VARYING WS-MAX FROM 1 BY 1
UNTIL WS-LETTER(WS-MAX) = SPACE
END-PERFORM.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I = WS-MAX
PERFORM VARYING WS-J FROM WS-I BY 1
UNTIL WS-J > WS-MAX - 1
IF WS-LETTER(WS-J) < WS-LETTER(WS-I) THEN
MOVE WS-LETTER(WS-I) TO WS-LETTER-HLD
MOVE WS-LETTER(WS-J) TO WS-LETTER(WS-I)
MOVE WS-LETTER-HLD TO WS-LETTER(WS-J)
END-IF
END-PERFORM
END-PERFORM.
400-ADD-TO-TABLE.
SET WT-IDX TO
SEARCH WT-RECORD
AT END
WHEN WT-WORD-KEY(WT-IDX) = WS-WORD-KEY
PERFORM 440-UPDATE-RECORD
END-SEARCH.
420-ADD-RECORD.
ADD 1 To WT-REC-NBR.
MOVE WS-WORD-KEY TO WT-WORD-KEY(WT-REC-NBR).
COMPUTE WT-WORD-LEN(WT-REC-NBR) = WS-MAX - 1 END-COMPUTE.
MOVE 1 TO WT-ANAGRAM-CNT(WT-REC-NBR).
WT-ANAGRAM(WT-REC-NBR, WT-ANAGRAM-CNT(WT-REC-NBR)).
440-UPDATE-RECORD.
ADD 1
MOVE WS-WORD-IN TO
WT-ANAGRAM(WT-IDX, WT-ANAGRAM-CNT(WT-IDX)).
500-FIND-DERANGED.
PERFORM VARYING WS-I FROM 1
PERFORM VARYING
UNTIL
PERFORM VARYING WS-K FROM WS-BEG BY 1
UNTIL WS-K > WT-ANAGRAM-CNT(WS-I) OR WS-FND = 'Y'
MOVE WT-ANAGRAM(WS-I, WS-J) TO WS-WORD-TEMP1
MOVE WT-ANAGRAM(WS-I, WS-K) To WS-WORD-TEMP2
PERFORM 650-CHECK-DERANGED
END-PERFORM
END-PERFORM
END-PERFORM.
650-CHECK-DERANGED.
MOVE
PERFORM VARYING WS-L FROM 1 BY 1
UNTIL WS-L
IF WS-LETTER1(WS-L) = WS-LETTER2(WS-L)
MOVE 'Y' TO WS-EXIT
END-IF
END-PERFORM.
IF WS-EXIT = 'N'
DISPLAY
WS-WORD-TEMP1(1:WT-WORD-LEN(WS-I)) ' ' WS-WORD-TEMP2
END-DISPLAY
MOVE 'Y' TO WS-FND
END-IF.
900-TERMINATE.
DISPLAY 'RECORDS READ: ' WS-TOT-RECS.
DISPLAY 'RECORDS SELECTED ' WS-SEL-RECS.
DISPLAY 'RECORD KEYS: ' WT-REC-NBR.
CLOSE IN-FILE.
END PROGRAM
*> OUTPUT:
*>
*> RECORDS READ: 25104
*> RECORDS SELECTED 24978
*> RECORD KEYS: 23441
*> BUBBLE SORT REFERENCE:
*> https://mainframegeek.wordpress.com/tag/bubble-sort-in-cobol
</syntaxhighlight>
=={{header|CoffeeScript}}==
This example was tested with node.js.
<
is_derangement = (word1, word2) ->
Line 1,995 ⟶ 2,037:
req.end()
get_word_list show_longest_derangement</
{{out}}
<pre>
Line 2,003 ⟶ 2,045:
=={{header|Common Lisp}}==
<
(with-open-file (stream file)
(loop with w = "" while w collect (setf w (read-line stream nil)))))
Line 2,022 ⟶ 2,064:
(setf (gethash ws h) (cons w l))))))
(format t "~{~A~%~^~}" (longest-deranged "unixdict.txt"))</
{{out}}
<pre>intoxicate
Line 2,029 ⟶ 2,071:
=={{header|D}}==
===Short Version===
<
import std.stdio, std.file, std.algorithm, std.string, std.array;
Line 2,043 ⟶ 2,085:
.minPos!q{ a[0].length > b[0].length }[0]
.writeln;
}</
{{out}}
<pre>Tuple!(string, string)("intoxicate", "excitation")</pre>
Line 2,049 ⟶ 2,091:
Using const(ubytes)[] instead of dstrings gives a runtime of about 0.07 seconds:
<
foreach (const w; "unixdict.txt".readText.split)
anags[w.dup.representation.sort().release.assumeUnique] ~= w;</
===Faster Version===
<
std.functional, std.exception;
Line 2,083 ⟶ 2,125:
return writefln("Longest deranged: %-(%s %)", pairs.front);
}
}</
{{out}}
<pre>Longest deranged: excitation intoxicate</pre>
Line 2,091 ⟶ 2,133:
{{libheader| System.Classes}}
{{libheader| System.Diagnostics}}
<
{$APPTYPE CONSOLE}
Line 2,195 ⟶ 2,237:
Dict.Free;
Readln;
end.</
{{out}}
Line 2,208 ⟶ 2,250:
=={{header|EchoLisp}}==
For a change, we use the french dictionary included in EchoLisp package.
<
(lib 'struct)
(lib 'sql)
Line 2,239 ⟶ 2,281:
(write lmin) (for-each write lw)
(writeln)))
</syntaxhighlight>
{{out}}
<
(lib 'dico.fr.no-accent) ;; 209315 words into *words* table
(task)
Line 2,263 ⟶ 2,305:
14 charlatanistic antarchistical
15 megachiropteran cinematographer
17 misconstitutional constitutionalism</
=={{header|Eiffel}}==
<
ANAGRAMS_DERANGED
Line 2,389 ⟶ 2,431:
words: HASH_TABLE [LINKED_LIST [STRING], STRING]
end</
{{out}}
<pre>
Line 2,398 ⟶ 2,440:
=={{header|Elixir}}==
{{trans|Ruby}}
<
def deranged(fname) do
File.read!(fname)
Line 2,427 ⟶ 2,469:
{_, words} -> IO.puts "Longest derangement anagram: #{inspect words}"
_ -> IO.puts "derangement anagram: nothing"
end</
{{out}}
Line 2,436 ⟶ 2,478:
=={{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] ).
Line 2,475 ⟶ 2,517:
lists:all( fun is_deranged_char/1, lists:zip(Word1, Word2) ).
is_deranged_char( {One, Two} ) -> One =/= Two.</
{{out}}
<pre>
Line 2,483 ⟶ 2,525:
=={{header|F_Sharp|F#}}==
<
let keyIsSortedWord = Seq.sort >> Seq.toArray >> String
Line 2,508 ⟶ 2,550:
|> snd
|> printfn "%A"
0</
{{out}}
<pre>[("excitation", "intoxicate")]</pre>
=={{header|Factor}}==
<
math.combinatorics sequences sorting strings ;
IN: rosettacode.deranged-anagrams
Line 2,536 ⟶ 2,578:
: longest-deranged-anagrams ( path -- anagrams )
deranged-anagrams [ first length ] sort-with last ;</
"unixdict.txt" longest-deranged-anagrams .
Line 2,542 ⟶ 2,584:
=={{header|FreeBASIC}}==
<
Type IndexedWord
Line 2,676 ⟶ 2,718:
Print
Print "Press any key to quit"
Sleep</
{{out}}
Line 2,687 ⟶ 2,729:
Took 0.089 seconds on i3 @ 2.13 GHz
</pre>
=={{header|FutureBasic}}==
While there is nothing time sensitive about this task, fast code is often efficient code. Several of the entries in this category show their computation times. This FutureBasic entry is designed to outrace them all.
The other entries examined have started by sorting the letters in each word. Here we take a different approach by creating an "avatar" for each word. All anagrams of a word have the same avatar—-without any sorting. Here's how it works:<br>
An 8-byte variable can hold a lot of information. We create a 64-bit avatar that starts at the high end with 8 bits for the length of the word, so that longer words will be sorted first. The remaining 56 bits contain 2-bit fields for each letter of the alphabet. A 2-bit field can record from 0 to 3 occurrences of the letter, but even if there were 4 or more occurrences (think "Mississippi"), bleeding into the next field, the only matching avatar would still be an exact anagram. Here's how the bits would be set for the word "Anagrams":
<syntaxhighlight lang="future basic">
Anagrams
length ZzYyXx WwVvUuTt SsRrQqPp OoNnMmLl KkJjIiHh GgFfEeDd CcBbAa
00001000 00000000 00000000 01010000 00010100 00000000 01000000 00001100
</syntaxhighlight>
Bit shifts and 8-byte comparisons are fast operations, which contribute to the speed. As each avatar is generated, it is saved, along with the offset to its word, and an index to it inserted in a sorted list, guaranteeing that longest words occur first, and all matching anagrams are adjacent.
When words have the same avatars, they are anagrams, but for this task we still need to check for letters occurring in the same location in both words. That is a quick check that only has to be done for otherwise qualified candidates.
On a 1.2 GHz Quad-Core Intel Core i7 MacBook Pro, this code runs in ~6 ms, which is several times faster than times claimed by other entries. In that time, it finds not just the longest, but all 486 deranged anagrams in unixdict.txt. (Yes, there is an option to view all of them.)
FWIW, this code can easily be amended to show all 1800+ anagram pairs.
<syntaxhighlight lang="future basic">
#plist NSAppTransportSecurity @{NSAllowsArbitraryLoads:YES}
defstr long
begin globals
xref xwords( 210000 ) as char
long gAvatars( 26000 )
uint32 gwordNum, gfilen, gcount = 0, gOffset( 26000 )
uint16 gndx( 26000 ), deranged( 600, 1 )
long sh : sh = system( _scrnHeight ) -100
long sw : sw = (system( _scrnWidth ) -360 ) / 2
CFTimeInterval t
_len = 56
end globals
local fn loadDictionary
CFURLRef url = fn URLWithString( @"http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" )
CFStringRef dictStr = fn StringWithContentsOfURL( url, NSUTF8StringEncoding, NULL )
dictStr = fn StringByAppendingString( @" ", dictStr )
xwords = fn StringUTF8String( dictstr )
gfilen = len(dictstr)
end fn
local fn deranagrams
uint64 ch, p, wordStart = 0
long avatar = 0
uint32 med, bot, top
byte chk, L
for p = 1 to gfilen
ch = xwords(p) //build avatar
if ch > _" " then avatar += (long) 1 << ( ch and 31 ) * 2: continue
avatar += (long)(p - wordStart - 1) << _len //complete avatar by adding word length
gAvatars(gWordNum) = avatar //store the avatar in list
gOffset( gWordNum) = wordStart //store offset to the word
//Insert into ordered list of avatars
bot = 0 : top = gwordNum //quick search for place to insert
while (top - bot) > 1
med = ( top + bot ) >> 1
if avatar > gAvatars(gndx(med)) then bot = med else top = med
wend
blockmove( @gndx( top ), @gndx( top + 1 ), ( gwordNum - top ) * 2 )
gndx(top) = gWordNum
gwordNum++ : wordStart = p : avatar = 0 //ready for new word
next p
//Check for matching avatars
for p = gWordNum to 1 step -1
chk = 1 //to make sure each word is compared with all matching avatars
while gAvatars( gndx( p ) ) == gAvatars( gndx( p - chk ) )
// found anagram; now check for chars in same position
L = ( gAvatars( gndx( p ) ) >> _len ) //get word length
while L
if xwords(gOffset(gndx(p)) +L) == xwords(gOffset(gndx(p-chk)) +L) then break
L--
wend
if L == 0
//no matching chars: found Deranged Anagram!
deranged( gcount, 0 ) = gndx( p )
deranged( gcount, 1 ) = gndx( p - chk )
gcount++
end if
chk++
wend
next
end fn
local fn printPair( ndx as uint32, chrsToCntr as byte )
ptr p : str255 pair : pair = ""
short n = ( gAvatars( deranged( ndx, 0 ) ) >> _len )
if n < chrsToCntr then print string$( chrsToCntr - n, " " );
p = xwords + gOffset( deranged( ndx, 0 ) )
p.0`` = n : print p.0$; " ";
p = xwords + gOffset( deranged( ndx, 1 ) )
p.0`` = n : print p.0$
end fn
local fn doDialog(evt as long)
if evt == _btnclick
long r
button -1 : window 1,,(sw,50,335,sh-50)
for r = 1 to gcount-1
fn printPair( r, 21 )
next
end if
end fn
fn loadDictionary : t = fn CACurrentMediaTime
fn deranagrams : t = fn CACurrentMediaTime - t
window 1, @"Deranged Anagrams in FutureBasic",(sw,sh-130,335,130)
printf @"\n %u deranged anagrams found among \n %u words ¬
in %.2f ms.\n", gcount, gWordNum, t * 1000
print " Longest:";: fn printPair( 0, 11 )
button 1,,,fn StringWithFormat(@"Show remaining %u deranged anagrams.",gcount-1),(24,20,285,34)
on dialog fn doDialog
handleevents
</syntaxhighlight>
{{out}}
[[File:FB output for Deranged Anagrams.png]]
=={{header|GAP}}==
Using function [[Anagrams#GAP|Anagrams]].
<
local i, n;
for i in [1 .. Size(a)] do
Line 2,719 ⟶ 2,884:
n := Maximum(List(a, x -> Size(x[1])));
Filtered(a, x -> Size(x[1]) = n);
# [ [ "excitation", "intoxicate" ] ]</
=={{header|Go}}==
<
import (
"fmt"
Line 2,773 ⟶ 2,938:
fmt.Println(w1, w2, ": Length", best_len)
}</
{{out}}
<pre>
Line 2,781 ⟶ 2,946:
=={{header|Groovy}}==
Solution:
<
new URL('http://www.puzzlers.org/pub/wordlists/unixdict.txt').eachLine { word ->
Line 2,809 ⟶ 2,974:
} else {
println 'Deranged anagrams are a MYTH!'
}</
{{out}}
Line 2,816 ⟶ 2,981:
=={{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)
Line 2,859 ⟶ 3,024:
case maxDerangedAnagram $ words input of
Nothing -> putStrLn "No deranged anagrams were found."
Just (a, b) -> putStrLn $ "Longest deranged anagrams: " <> a <> " and " <> b</
{{out}}
<pre>Longest deranged anagrams: excitation and intoxicate</pre>
and a variant:
<syntaxhighlight lang="haskell">import Control.Monad ((<=<))
import Data.Function (on)
import Data.List (find, groupBy, sort, sortOn)
import Data.Ord (Down (Down))
-------------------- DERANGED ANAGRAMS -------------------
longestDeranged :: [String] -> String
longestDeranged xs =
case find deranged (longestAnagramPairs xs) of
Nothing -> "No deranged anagrams found."
Just (a, b) -> a <> " -> " <> b
deranged :: (String, String) -> Bool
deranged (a, b) = and (zipWith (/=) a b)
longestAnagramPairs :: [String] -> [(String, String)]
longestAnagramPairs = ((<*>) =<< fmap (,)) <=<
(sortOn (Down . length . head) . anagramGroups)
anagramGroups :: [String] -> [[String]]
anagramGroups xs =
groupBy
(on (==) fst)
(sortOn fst (((,) =<< sort) <$> xs))
>>= (\g -> [snd <$> g | 1 < length g])
--------------------------- TEST -------------------------
main :: IO ()
main =
readFile "unixdict.txt"
>>= (putStrLn . longestDeranged . lines)</syntaxhighlight>
{{Out}}
<pre>excitation -> 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()
Line 2,890 ⟶ 3,092:
every i := 1 to *s1 do if s1[i] == s2[i] then fail
return [s1,s2]
end</
{{out|Sample run}}
<pre>->dra <unixdict.txt
Line 2,898 ⟶ 3,100:
=={{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
Line 2,911 ⟶ 3,113:
││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>
Line 2,918 ⟶ 3,120:
=={{header|Java}}==
{{works with|Java|8}}
<
import java.io.IOException;
import java.nio.file.Files;
Line 2,964 ⟶ 3,166:
return true;
}
}</
{{out}}
<pre>excitation intoxicate</pre>
Line 2,976 ⟶ 3,178:
brevity.
<
function main() {
Line 3,050 ⟶ 3,252:
}
main();</
{{out}}
Line 3,057 ⟶ 3,259:
=== 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">
Line 3,101 ⟶ 3,303:
show(best_pair);
</script></body></html></
{{Out|Output (in a browser window)}}
Line 3,111 ⟶ 3,313:
This solution allows for the possibility of more than one answer.
<
# Output: a stream of arrays
def anagrams:
Line 3,142 ⟶ 3,344:
else .
end) ) )
| unique</
'''Invocation and output'''
Line 3,150 ⟶ 3,352:
=={{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.
Line 3,192 ⟶ 3,394:
break
end
end</
{{out}}
Line 3,198 ⟶ 3,400:
=={{header|K}}==
<
a:{x g@&1<#:'g:={x@<x}'x}@0:"unixdict.txt";
Line 3,204 ⟶ 3,406:
b@&c=|/c:{#x[0]}'b:a@&{0=+//{x=y}':x}'a
("excitation"
"intoxicate")</
=={{header|Kotlin}}==
<
import java.io.BufferedReader
Line 3,245 ⟶ 3,447:
.filter { it.size > 1 && it[0].length == count }
.forEach { println(it) }
}</
{{out}}
Line 3,253 ⟶ 3,455:
=={{header|Lasso}}==
<
anagrams = map,
words = include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt') -> split('\n'),
Line 3,305 ⟶ 3,507:
}
#findings -> join('<br />\n')</
Result -> excitation, intoxicate
=={{header|Liberty BASIC}}==
<
open "unixdict.txt" for input as #1
a$=input$(#1,lof(#1))
Line 3,361 ⟶ 3,563:
print theWord$(maxPtrI);" => ";theWord$(maxPtrJ)
end</
{{out}}
excitation => intoxicate
=={{header|Lua}}==
<
local arr={}
for ch in str:gmatch(".") do arr[#arr+1]=ch end
Line 3,401 ⟶ 3,603:
end
end
print(answer.word, answer.anag, answer.len)</
{{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))):
select(w->length(w)=len,L)[];</
{{out}}
<pre>
Line 3,417 ⟶ 3,619:
=={{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&];
First@Flatten[Function[ws,Select[Join@@Outer[List,ws,ws,1],anagramDegrangement@@#&]]/@SortBy[gs,-StringLength@First@#&],1]</
{{out}}
<pre>
Line 3,429 ⟶ 3,631:
A similar approach using Mathematica 10:
<
MaximalBy[
Select[GatherBy[list, Sort@*Characters],
Length@# > 1 && And @@ MapThread[UnsameQ, Characters /@ #] &],
StringLength@*First]</
{{out}}
Line 3,441 ⟶ 3,643:
=={{header|Nim}}==
<
import tables
import times
Line 3,481 ⟶ 3,683:
echo "Longest deranged anagram pair: ", best1, " ", best2
echo "Processing time: ", (getTime() - t0).inMilliseconds, " ms."</
{{out}}
Line 3,488 ⟶ 3,690:
=={{header|OCaml}}==
<
let r = String.copy s in
for i = 0 to (String.length r) - 2 do
Line 3,552 ⟶ 3,754:
) ([], 0) lst
in
List.iter (fun (w1, w2) -> Printf.printf "%s, %s\n" w1 w2) res</
{{out}}
<pre>$ ocaml deranged_anagram.ml
Line 3,558 ⟶ 3,760:
=={{header|ooRexx}}==
<
-- in the current directory: http://www.puzzlers.org/pub/wordlists/unixdict.txt
Line 3,620 ⟶ 3,822:
loop pair over pairs
say pair[1] pair[2]
end</
{{out}}
<pre>
Line 3,628 ⟶ 3,830:
=={{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);
Line 3,636 ⟶ 3,838:
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)), []);
forstep(n=vecmax(len),1,-1, t=f(n); if(#t, return(t)))</
{{out}}
<pre>%1 = [["excitation", "intoxicate"]]</pre>
Line 3,643 ⟶ 3,845:
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}
Line 3,759 ⟶ 3,961:
Dict.Free;
end.
</syntaxhighlight>
{{out}}
<pre>
Line 3,769 ⟶ 3,971:
=={{header|Perl}}==
===String operations===
<syntaxhighlight lang="perl">use strict;
use warnings;
sub deranged { # only anagrams ever get here
my @a = split('', shift); # split word into letters
my @b = split('', shift);
Line 3,803 ⟶ 4,009:
keys %letter_list )
{
# if we find a pair, they are the
last if find_deranged(@{ $letter_list{$_} });
}</
{{out}}
<pre>length 10: excitation => intoxicate</pre>
===Bitwise operations===
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'bitwise';
local (@ARGV, $/) = 'unixdict.txt';
Line 3,822 ⟶ 4,025:
{
my $key = join '', sort +split //, $word;
($_ ^. $word) =~ /\0/ or exit !print "$_ $word\n" for @{ $anagrams{$key} };
push @{ $anagrams{$key} }, $word;
}</
{{out}}
<pre>excitation intoxicate</pre>
=={{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>
Line 3,877 ⟶ 4,078:
<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>
Line 3,883 ⟶ 4,084:
excitation, intoxicate
</pre>
=={{header|Phixmonti}}==
<syntaxhighlight lang="phixmonti">/# Rosetta Code problem: http://rosettacode.org/wiki/Anagrams/Deranged_anagrams
by Galileo, 06/2022 #/
include ..\Utilitys.pmt
"unixdict.txt" "r" fopen var f
( )
true while
f fgets
dup -1 == if
drop
f fclose
false
else
-1 del
dup sort swap 2 tolist
0 put
true
endif
endwhile
sort
0 var largest
( ) var candidate
( len 2 swap ) for var i
( i 1 ) sget >ps
( i 1 - 1 ) sget ps> == if
( i 2 ) sget >ps
( i 1 - 2 ) sget ps> len >ps
true var test
tps for var j
j get rot j get rot == if false var test exitfor endif
endfor
test tps largest > and if
ps> var largest
2 tolist var candidate
else
ps> drop drop drop
endif
endif
endfor
candidate print
</syntaxhighlight>
{{out}}
<pre>["excitation", "intoxicate"]
=== Press any key to exit ===</pre>
=={{header|PHP}}==
<
$words = file(
'http://www.puzzlers.org/pub/wordlists/unixdict.txt',
Line 3,935 ⟶ 4,189:
echo implode(" ", $final_word), "\n";
}
?></
{{out}}
<pre>
excitation intoxicate
</pre>
=={{header|Picat}}==
<syntaxhighlight lang="picat">go =>
M = [W:W in read_file_lines("unixdict.txt")].group(sort),
Deranged = [Value : _Key=Value in M, Value.length > 1, allderanged(Value)],
MaxLen = max([V[1].length : V in Deranged]),
println([V : V in Deranged, V[1].length==MaxLen]),
nl.
% A and B are deranged: i.e. there is no
% position with the same character.
deranged(A,B) =>
foreach(I in 1..A.length)
A[I] != B[I]
end.
% All words in list Value are deranged anagrams of each other.
allderanged(Value) =>
IsDeranged = 1,
foreach(V1 in Value, V2 in Value, V1 @< V2, IsDeranged = 1)
if not deranged(V1,V2) then
IsDeranged := 0
end
end,
IsDeranged == 1.
% Groups the element in List according to the function F
group(List, F) = P, list(List) =>
P = new_map(),
foreach(E in List)
V = apply(F,E),
P.put(V, P.get(V,[]) ++ [E])
end.</syntaxhighlight>
{{out}}
<pre>[[excitation,intoxicate]]</pre>
=={{header|PicoLisp}}==
<
(in "unixdict.txt"
(while (line)
Line 3,960 ⟶ 4,250:
(cons (pack @) (pack Lst)) ) )
(val Key) ) )
(idx 'Words) ) ) )</
{{out}}
<pre>-> ("excitation" . "intoxicate")</pre>
=={{header|PowerShell}}==
<
{
$array1 = $Strings[0].ToCharArray()
Line 3,997 ⟶ 4,287:
Length = $deranged[0].Length
Words = $deranged
}</
{{Out}}
<pre>
Line 4,007 ⟶ 4,297:
=={{header|Prolog}}==
{{Works with|SWI Prolog}}
<
http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt',In,[]),
read_file(In, [], Out),
Line 4,064 ⟶ 4,354:
msort(W, W1),
atom_codes(A, W1),
read_file(In, [A-W | L], L1)).</
{{out}}
<pre> ?- longest_deranged_anagram.
Line 4,072 ⟶ 4,362:
=={{header|PureBasic}}==
<
word.s
letters.s
Line 4,206 ⟶ 4,496:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</
{{out}}
<pre>Largest 'Deranged' anagrams found are of length 10:
Line 4,214 ⟶ 4,504:
=={{header|Python}}==
<
from collections import defaultdict
from itertools import combinations
Line 4,252 ⟶ 4,542:
print("Longest anagrams with no characters in the same position:")
print(' ' + '\n '.join(', '.join(pairs)
for pairs in largest_deranged_ana(anagrams)))</
{{out}}
<pre>Word count: 25104
Line 4,264 ⟶ 4,554:
Append the following to the previous code:
<
ordered_anagrams = sorted(anagrams.items(),
key=lambda x:(-len(x[0]), x[0]))
Line 4,281 ⟶ 4,571:
for pairs in most:
print()
print(' ' + '\n '.join(', '.join(p) for p in pairs))</
{{out}}
Line 4,313 ⟶ 4,603:
===Python: Faster Version===
<
from itertools import combinations
from pathlib import Path
Line 4,399 ⟶ 4,689:
if __name__ == '__main__':
main()</
{{out}}
<pre>The longest anagram is: excitation, intoxicate</pre>
Line 4,405 ⟶ 4,695:
=={{header|Quackery}}==
<
[ 2drop false ] done
over sort over sort != iff
Line 4,427 ⟶ 4,717:
temp take
sortwith [ 0 peek size swap 0 peek size > ]
0 peek witheach [ echo$ sp ]</
{{out}}
Line 4,434 ⟶ 4,724:
=={{header|R}}==
<
longest.deranged.anagram <- function(dict=puzzlers.dict) {
Line 4,458 ⟶ 4,748:
}
}
}</
{{out}}
<
a b
3 excitation intoxicate</
=={{header|Racket}}==
<
(define word-list-file "data/unixdict.txt")
Line 4,508 ⟶ 4,798:
(daps (in-value (deranged-anagram-pairs anagrams)))
#:unless (null? daps))
daps)</
{{out}}
<pre>'(("intoxicate" "excitation"))</pre>
Line 4,517 ⟶ 4,807:
{{works with|Rakudo|2016.08}}
<syntaxhighlight lang="raku"
.map(*.comb.cache) # explode words into lists of characters
.classify(*.sort.join).values # group words with the same characters
Line 4,531 ⟶ 4,821:
}
}
}</
{{out}}
Line 4,537 ⟶ 4,827:
=={{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*/
Line 4,578 ⟶ 4,868:
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
end /*while !.k···*/; end /*i*/; end /*while h>1*/; return</
{{out|output|text= when using the default dictionary:}}
<pre>
Line 4,586 ⟶ 4,876:
=={{header|Ring}}==
<
load "stdlib.ring"
Line 4,664 ⟶ 4,954:
astring = substr(astring,substr(astring,bstring)+len(string(sum)))
end
return cnt</
{{out}}
<pre>
Line 4,671 ⟶ 4,961:
=={{header|Ruby}}==
<
a.chars.zip(b.chars).all? {|char_a, char_b| char_a != char_b}
end
Line 4,692 ⟶ 4,982:
break
end
end</
{{out}}
<pre>
Line 4,699 ⟶ 4,989:
=={{header|Run BASIC}}==
<
dim theWord$(30000)
dim ssWord$(30000)
Line 4,745 ⟶ 5,035:
print maxLen;" ";theWord$(maxPtrI);" => ";theWord$(maxPtrJ)
end</
{{out}}
<pre>10 excitation => intoxicate</pre>
=={{header|Rust}}==
<
use std::cmp::Ordering;
use std::collections::HashMap;
Line 4,824 ⟶ 5,114:
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 */
Line 4,862 ⟶ 5,152:
}
}</
{{out}}
<pre>Longest deranged pair: excitation and intoxicate</pre>
Line 4,868 ⟶ 5,158:
=={{header|Scheme}}==
<
(scheme char)
(scheme cxr)
Line 4,916 ⟶ 5,206:
(cdr rem))))))))
(display (find-deranged-words (read-ordered-words))) (newline)</
{{out}}
Line 4,924 ⟶ 5,214:
=={{header|Sidef}}==
<
for i in (^a) {
for j in (i+1 .. a.end) {
Line 4,958 ⟶ 5,248:
}
main(%f'/tmp/unixdict.txt')</
{{out}}
<pre>length 10: excitation => intoxicate</pre>
=={{header|Simula}}==
<
BEGIN
Line 5,094 ⟶ 5,384:
OUTTEXT(VECT.ELEMENT(P1) & " " & VECT.ELEMENT(P2));
OUTIMAGE;
END</
{{out}}
<pre>intoxicate excitation
Line 5,102 ⟶ 5,392:
=={{header|Tcl}}==
<
package require http
Line 5,154 ⟶ 5,444:
puts "considered candidate pairing: $pair"
}
puts "MAXIMAL DERANGED ANAGRAM: LENGTH $max\n\t[lindex $candidates end]"</
{{out}}
<pre>
Line 5,173 ⟶ 5,463:
=={{header|TUSCRIPT}}==
<
requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
Line 5,217 ⟶ 5,507:
ENDLOOP
ENDLOOP
ENDCOMPILE</
{{out}}
<pre>
Line 5,226 ⟶ 5,516:
=={{header|UNIX Shell}}==
{{works with|ksh93}}
<
typeset host=www.puzzlers.org
typeset page=/pub/wordlists/unixdict.txt
Line 5,272 ⟶ 5,562:
fi
done <word.list
echo $max - ${max_deranged[@]} </
{{out}}
<pre>10 - excitation intoxicate</pre>
Line 5,278 ⟶ 5,568:
=={{header|Ursala}}==
This solution assumes the file <code>unixdict.txt</code> is passed to the compiler as a command line parameter.
<
anagrams = |=tK33lrDSL2SL ~=&& ==+ ~~ -<&
Line 5,286 ⟶ 5,576:
#cast %sW
main = leql$^&l deranged anagrams unixdict_dot_txt</
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 =
Line 5,300 ⟶ 5,590:
#cast %sW
main = longest_deranged_anagram unixdict_dot_txt</
{{out}}
<pre>
Line 5,307 ⟶ 5,597:
=={{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
Line 5,356 ⟶ 5,646:
DerangedAnagram = True
Lenght = Len(str1)
End Function</
{{out}}
Line 5,363 ⟶ 5,653:
Lenght : 10
Time to compute : 97,00781 sec.</pre>
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v (vlang)">import os
fn deranged(a string, b string) bool {
if a.len != b.len {
return false
}
for i in 0..a.len {
if a[i] == b[i] { return false }
}
return true
}
fn main(){
words := os.read_lines('unixdict.txt')?
mut m := map[string][]string{}
mut best_len, mut w1, mut w2 := 0, '',''
for w in words {
// don't bother: too short to beat current record
if w.len <= best_len { continue }
// save strings in map, with sorted string as key
mut letters := w.split('')
letters.sort()
k := letters.join("")
if k !in m {
m[k] = [w]
continue
}
for c in m[k] {
if deranged(w, c) {
best_len, w1, w2 = w.len, c, w
break
}
}
m[k] << w
}
println('$w1 $w2: Length $best_len')
}</syntaxhighlight>
{{out}}
<pre>
excitation intoxicate: Length 10
</pre>
=={{header|Wren}}==
{{libheader|Wren-sort}}
<
import "./sort" for Sort
// assumes w1 and w2 are anagrams of each other
Line 5,406 ⟶ 5,747:
for (words in deranged) {
if (words[0].count == most) System.print([words[0], words[1]])
}</
{{out}}
Line 5,414 ⟶ 5,755:
=={{header|zkl}}==
<
File("unixdict.txt").read().pump(Void,'wrap(w){
w=w.strip(); key:=w.sort(); words[key]=words.find(key,T).append(w);
Line 5,435 ⟶ 5,776:
nws.filter(fcn(nws,max){ nws[0]==max },
nws.reduce(fcn(p,nws){ p.max(nws[0]) },0) )
.println();</
{{out}}
<pre>
Line 5,441 ⟶ 5,782:
</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
Line 5,450 ⟶ 5,791:
}
Void.Skip
});</
|