Anagrams/Deranged anagrams: Difference between revisions
m
→{{header|Wren}}: Minor tidy
Thundergnat (talk | contribs) m (Automated syntax highlighting fixup (second round - minor fixes)) |
m (→{{header|Wren}}: Minor tidy) |
||
(8 intermediate revisions by 8 users not shown) | |||
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 47:
{{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 }}
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)</syntaxhighlight>
Line 801 ⟶ 800:
{{output}}
<syntaxhighlight lang="applescript">{{"excitation", "intoxicate"}}</syntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
Line 1,411:
</pre>
=={{header|
==={{header|BaCon}}===
<syntaxhighlight lang="freebasic">DECLARE idx$ ASSOC STRING
Line 1,448 ⟶ 1,449:
</pre>
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> INSTALL @lib$+"SORTLIB"
Line 1,812 ⟶ 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>
Line 2,728 ⟶ 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}}==
Line 2,903 ⟶ 3,027:
{{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}}==
Line 3,810 ⟶ 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,844 ⟶ 4,009:
keys %letter_list )
{
# if we find a pair, they are the
last if find_deranged(@{ $letter_list{$_} });
}</syntaxhighlight>
{{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,863 ⟶ 4,025:
{
my $key = join '', sort +split //, $word;
($_ ^. $word) =~ /\0/ or exit !print "$_ $word\n" for @{ $anagrams{$key} };
push @{ $anagrams{$key} }, $word;
}</syntaxhighlight>
{{out}}
<pre>excitation intoxicate</pre>
=={{header|Phix}}==
Line 5,494 ⟶ 5,654:
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 {
Line 5,547 ⟶ 5,707:
=={{header|Wren}}==
{{libheader|Wren-sort}}
<syntaxhighlight lang="
import "./sort" for Sort
// assumes w1 and w2 are anagrams of each other
|