Anagrams: Difference between revisions
added Emacs ELisp code for anagram exercise
(Add Jsish, move a Javascript subheading) |
(added Emacs ELisp code for anagram exercise) |
||
| (79 intermediate revisions by 43 users not shown) | |||
Line 3:
When two or more words are composed of the same characters, but in a different order, they are called [[wp:Anagram|anagrams]].
;Task
Using the word list at http://wiki.puzzlers.org/pub/wordlists/unixdict.txt,
<br>find the sets of words that share the same characters that contain the most words in them.
{{Related tasks/Word plays}}
{{Template:Strings}}
<br><br>
=={{header|11l}}==
{{trans|Python}}
<
L(word) File(‘unixdict.txt’).read().split("\n")
anagram[sorted(word
V count = max(anagram.values().map(ana -> ana.len))
Line 24 ⟶ 25:
L(ana) anagram.values()
I ana.len == count
print(ana)</
{{out}}
<pre>
Line 36 ⟶ 37:
=={{header|8th}}==
<
\
\ anagrams.8th
\ Rosetta Code - Anagrams problem
\ Using the word list at:
\ http://
\ find the sets of words that share the same characters
\ that contain the most words in them.
Line 169 ⟶ 170:
bye
;
</syntaxhighlight>
=={{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 anagram64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ MAXI, 40000
.equ BUFFERSIZE, 300000
/*********************************/
/* Initialized data */
/*********************************/
.data
szFileName: .asciz "./listword.txt"
szMessErreur: .asciz "FILE ERROR."
szCarriageReturn: .asciz "\n"
szMessSpace: .asciz " "
ptBuffex1: .quad sBuffex1
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
ptTabBuffer: .skip 8 * MAXI
ptTabAna: .skip 8 * MAXI
tbiCptAna: .skip 8 * MAXI
iNBword: .skip 8
sBuffer: .skip BUFFERSIZE
sBuffex1: .skip BUFFERSIZE
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
mov x4,#0 // loop indice
mov x0,AT_FDCWD // current directory
ldr x1,qAdrszFileName // file name
mov x2,#O_RDWR // flags
mov x3,#0 // mode
mov x8,#OPEN //
svc 0
cmp x0,#0 // error open
ble 99f
mov x19,x0 // FD save Fd
ldr x1,qAdrsBuffer // buffer address
ldr x2,qSizeBuf // buffersize
mov x8, #READ
svc 0
cmp x0,#0 // error read ?
blt 99f
mov x5,x0 // save size read bytes
ldr x4,qAdrsBuffer // buffer address
ldr x0,qAdrsBuffer // start word address
mov x2,#0
mov x1,#0 // word length
1:
cmp x2,x5
bge 2f
ldrb w3,[x4,x2]
cmp w3,#0xD // end word ?
cinc x1,x1,ne // increment word length
cinc x2,x2,ne // increment indice
bne 1b // and loop
strb wzr,[x4,x2] // store final zero
bl anaWord // sort word letters
add x2,x2,#2 // jump OD and 0A
add x0,x4,x2 // new address begin word
mov x1,#0 // init length
b 1b // and loop
2:
strb wzr,[x4,x2] // zero final
bl anaWord // last word
mov x0,x19 // file Fd
mov x8, #CLOSE
svc 0
cmp x0,#0 // error close ?
blt 99f
ldr x0,qAdrptTabAna // address sorted string area
mov x1,#0 // first indice
ldr x2,qAdriNBword
ldr x2,[x2] // last indice
ldr x3,qAdrptTabBuffer // address sorted string area
bl triRapide // quick sort
ldr x4,qAdrptTabAna // address sorted string area
ldr x7,qAdrptTabBuffer // address sorted string area
ldr x10,qAdrtbiCptAna // address counter occurences
mov x9,x2 // size word array
mov x8,#0 // indice first occurence
ldr x3,[x4,x8,lsl #3] // load first value
mov x2,#1 // loop indice
mov x6,#0 // counter
mov x12,#0 // counter value max
3:
ldr x5,[x4,x2,lsl #3] // load next value
mov x0,x3
mov x1,x5
bl comparStrings
cmp x0,#0 // sorted strings equal ?
bne 4f
add x6,x6,#1 // yes increment counter
b 5f
4: // no
str x6,[x10,x8,lsl #3] // store counter in first occurence
cmp x6,x12 // counter > value max
csel x12,x6,x12,gt // yes counter -> value max
//movgt x12,x6 // yes counter -> value max
mov x6,#0 // raz counter
mov x8,x2 // init index first occurence
mov x3,x5 // init value first occurence
5:
add x2,x2,#1 // increment indice
cmp x2,x9 // end word array ?
blt 3b // no -> loop
mov x2,#0 // raz indice
6: // display loop
ldr x6,[x10,x2,lsl #3] // load counter
cmp x6,x12 // equal to max value ?
bne 8f
ldr x0,[x7,x2,lsl #3] // load address first word
bl affichageMess
add x3,x2,#1 // increment new indixe
mov x4,#0 // counter
7:
ldr x0,qAdrszMessSpace
bl affichageMess
ldr x0,[x7,x3,lsl #3] // load address other word
bl affichageMess
add x3,x3,#1 // increment indice
add x4,x4,#1 // increment counter
cmp x4,x6 // max value ?
blt 7b // no loop
ldr x0,qAdrszCarriageReturn
bl affichageMess
8:
add x2,x2,#1 // increment indice
cmp x2,x9 // maxi ?
blt 6b // no -> loop
b 100f
99: // display error
ldr x0,qAdrszMessErreur
bl affichageMess
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszFileName: .quad szFileName
qAdrszMessErreur: .quad szMessErreur
qAdrsBuffer: .quad sBuffer
qSizeBuf: .quad BUFFERSIZE
qAdrszMessSpace: .quad szMessSpace
qAdrtbiCptAna: .quad tbiCptAna
/******************************************************************/
/* analizing word */
/******************************************************************/
/* x0 word address */
/* x1 word length */
anaWord:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
mov x5,x0
mov x6,x1
ldr x1,qAdrptTabBuffer
ldr x2,qAdriNBword
ldr x3,[x2]
str x0,[x1,x3,lsl #3]
ldr x1,qAdrptTabAna
ldr x4,qAdrptBuffex1
ldr x0,[x4]
add x6,x6,x0
add x6,x6,#1
str x6,[x4]
str x0,[x1,x3,lsl #3]
add x3,x3,#1
str x3,[x2]
mov x1,x0
mov x0,x5
bl triLetters // sort word letters
mov x2,#0
100:
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrptTabBuffer: .quad ptTabBuffer
qAdrptTabAna: .quad ptTabAna
qAdriNBword: .quad iNBword
qAdrptBuffex1: .quad ptBuffex1
/******************************************************************/
/* sort word letters */
/******************************************************************/
/* x0 address begin word */
/* x1 address recept array */
triLetters:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
mov x2,#0
1:
ldrb w3,[x0,x2] // load letter
cmp w3,#0 // end word ?
beq 6f
cmp x2,#0 // first letter ?
bne 2f
strb w3,[x1,x2] // yes store in first position
add x2,x2,#1 // increment indice
b 1b // and loop
2:
mov x4,#0
3: // begin loop to search insertion position
ldrb w5,[x1,x4] // load letter
cmp w3,w5 // compare
blt 4f // to low -> insertion
add x4,x4,#1 // increment indice
cmp x4,x2 // compare to letters number in place
blt 3b // search loop
strb w3,[x1,x2] // else store in last position
add x2,x2,#1
b 1b // and loop
4: // move first letters in one position
sub x6,x2,#1 // start indice
5:
ldrb w5,[x1,x6] // load letter
add x7,x6,#1 // store indice - 1
strb w5,[x1,x7] // store letter
sub x6,x6,#1 // decrement indice
cmp x6,x4 // end ?
bge 5b // no loop
strb w3,[x1,x4] // else store letter in free position
add x2,x2,#1
b 1b // and loop
6:
strb wzr,[x1,x2] // final zéro
100:
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/***************************************************/
/* Appel récursif Tri Rapide quicksort */
/***************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item */
/* x2 contains the number of elements > 0 */
/* x3 contains the address of table 2 */
triRapide:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
mov x6,x3
sub x2,x2,#1 // last item index
cmp x1,x2 // first > last ?
bge 100f // yes -> end
mov x4,x0 // save x0
mov x5,x2 // save x2
mov x3,x6
bl partition1 // cutting.quado 2 parts
mov x2,x0 // index partition
mov x0,x4 // table address
bl triRapide // sort lower part
mov x0,x4 // table address
add x1,x2,#1 // index begin = index partition + 1
add x2,x5,#1 // number of elements
bl triRapide // sort higter part
100: // end function
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* Partition table elements */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item */
/* x2 contains index of last item */
/* x3 contains the address of table 2 */
partition1:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
stp x8,x9,[sp,-16]! // save registers
stp x10,x12,[sp,-16]! // save registers
mov x8,x0 // save address table 2
mov x9,x1
ldr x10,[x8,x2,lsl #3] // load string address last index
mov x4,x9 // init with first index
mov x5,x9 // init with first index
1: // begin loop
ldr x6,[x8,x5,lsl #3] // load string address
mov x0,x6
mov x1,x10
bl comparStrings
cmp x0,#0
bge 2f
ldr x7,[x8,x4,lsl #3] // if < swap value table
str x6,[x8,x4,lsl #3]
str x7,[x8,x5,lsl #3]
ldr x7,[x3,x4,lsl #3] // swap array 2
ldr x12,[x3,x5,lsl #3]
str x7,[x3,x5,lsl #3]
str x12,[x3,x4,lsl #3]
add x4,x4,#1 // and increment index 1
2:
add x5,x5,#1 // increment index 2
cmp x5,x2 // end ?
blt 1b // no -> loop
ldr x7,[x8,x4,lsl #3] // swap value
str x10,[x8,x4,lsl #3]
str x7,[x8,x2,lsl #3]
ldr x7,[x3,x4,lsl #3] // swap array 2
ldr x12,[x3,x2,lsl #3]
str x7,[x3,x2,lsl #3]
str x12,[x3,x4,lsl #3]
mov x0,x4 // return index partition
100:
ldp x10,x12,[sp],16 // restaur 2 registers
ldp x8,x9,[sp],16 // restaur 2 registers
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/************************************/
/* Strings case sensitive comparisons */
/************************************/
/* x0 et x1 contains the address of strings */
/* return 0 in x0 if equals */
/* return -1 if string x0 < string x1 */
/* return 1 if string x0 > string x1 */
comparStrings:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
mov x2,#0 // counter
1:
ldrb w3,[x0,x2] // byte string 1
ldrb w4,[x1,x2] // byte string 2
cmp w3,w4
blt 2f // small
bgt 3f // greather
cmp x3,#0 // 0 end string
beq 4f // end string
add x2,x2,#1 // else add 1 in counter
b 1b // and loop
2:
mov x0,#-1 // small
b 100f
3:
mov x0,#1 // greather
b 100f
4:
mov x0,#0 // equal
100:
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
<pre>
~/.../rosetta/asm1 $ anagram64
bale able bela abel elba
cater carte crate caret trace
galen glean angle lange angel
regal glare alger lager large
lena lane lean elan neal
veil levi live vile evil
</pre>
=={{header|ABAP}}==
<
define update_progress.
call function 'SAPGUI_PROGRESS_INDICATOR'
Line 273 ⟶ 673:
return.
endif.
endform.</
{{out}}
<pre>[ angel , angle , galen , glean , lange ]
Line 283 ⟶ 683:
=={{header|Ada}}==
<
with Ada.Containers.Indefinite_Ordered_Maps;
Line 351 ⟶ 751:
Iterate (Result, Put'Access);
Close (File);
end Words_Of_Equal_Characters;</
{{out}}
<pre>
Line 364 ⟶ 764:
=={{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 456 ⟶ 856:
e := NEXT words
OD
FI</
{{out}}
<pre>
Line 468 ⟶ 868:
</pre>
=={{header|Amazing Hopper}}==
<syntaxhighlight lang="c">
#include <basico.h>
#define MAX_LINE 30
algoritmo
fd=0, filas=0
word={}, 2da columna={}
old_word="",new_word=""
dimensionar (1,2) matriz de cadenas 'result'
pos=0
token.separador'""'
abrir para leer("basica/unixdict.txt",fd)
iterar mientras ' no es fin de archivo (fd) '
usando 'MAX_LINE', leer línea desde(fd),
---copiar en 'old_word'---, separar para 'word '
word, ---retener--- ordenar esto,
encadenar en 'new_word'
matriz.buscar en tabla (1,new_word,result)
copiar en 'pos'
si ' es negativo? '
new_word,old_word, pegar fila en 'result'
sino
#( result[pos,2] = cat(result[pos,2],cat(",",old_word) ) )
fin si
reiterar
cerrar archivo(fd)
guardar 'filas de (result)' en 'filas'
#( 2da columna = result[2:filas, 2] )
fijar separador '","'
tomar '2da columna'
contar tokens en '2da columna' ---retener resultado,
obtener máximo valor,es mayor o igual?, replicar esto
compactar esto
fijar separador 'NL', luego imprime todo
terminar
</syntaxhighlight>
{{out}}
<pre>
abel,able,bale,bela,elba
alger,glare,lager,large,regal
angel,angle,galen,glean,lange
caret,carte,cater,crate,trace
elan,lane,lean,lena,neal
evil,levi,live,veil,vile
</pre>
=={{header|APL}}==
Line 475 ⟶ 931:
This is a rough translation of the J version, intermediate values are kept and verb trains are not used for clarity of data flow.
<syntaxhighlight lang="apl">
anagrams←{
tie←⍵ ⎕NTIE 0
Line 483 ⟶ 939:
({~' '∊¨(⊃/¯1↑[2]⍵)}ana)⌿ana ⋄ ⎕NUNTIE
}
</syntaxhighlight>
On a unix system we can assume wget exists and can use it from dyalog to download the file.
Line 489 ⟶ 945:
'''Example:'''
<syntaxhighlight lang="apl">
⎕SH'wget http://
]display anagrams 'unixdict.txt'
</syntaxhighlight>
'''Output:'''
<pre>
Line 516 ⟶ 972:
└∊────────────────────────────────────────┘
</pre>
=={{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 largestAnagramGroups(listOfWords)
script o
property wordList : listOfWords
property groupingTexts : wordList's items
property largestGroupSize : 0
property largestGroupRanges : {}
on judgeGroup(i, j)
set groupSize to j - i + 1
if (groupSize < largestGroupSize) then -- Most likely.
else if (groupSize = largestGroupSize) then -- Next most likely.
set end of largestGroupRanges to {i, j}
else -- Largest group so far.
set largestGroupRanges to {{i, j}}
set largestGroupSize to groupSize
end if
end judgeGroup
on isGreater(a, b)
return a's beginning > b's beginning
end isGreater
end script
set wordCount to (count o's wordList)
ignoring case
-- Replace the words in the groupingTexts list with sorted-character versions.
repeat with i from 1 to wordCount
set chrs to o's groupingTexts's item i's characters
tell sorter to sort(chrs, 1, -1, {})
set o's groupingTexts's item i to join(chrs, "")
end repeat
-- Sort the list to group its contents and echo the moves in the original word list.
tell sorter to sort(o's groupingTexts, 1, wordCount, {slave:{o's wordList}})
-- Find the list range(s) of the longest run(s) of equal grouping texts.
set i to 1
set currentText to beginning of o's groupingTexts
repeat with j from 2 to wordCount
set thisText to o's groupingTexts's item j
if (thisText is not currentText) then
tell o to judgeGroup(i, j - 1)
set currentText to thisText
set i to j
end if
end repeat
if (j > i) then tell o to judgeGroup(i, j)
-- Extract the group(s) of words occupying the same range(s) in the original word list.
set output to {}
repeat with thisRange in o's largestGroupRanges
set {i, j} to thisRange
-- Add this group to the output.
set thisGroup to o's wordList's items i thru j
tell sorter to sort(thisGroup, 1, -1, {}) -- Not necessary with unixdict.txt. But hey.
set end of output to thisGroup
end repeat
-- As a final flourish, sort the groups on their first items.
tell sorter to sort(output, 1, -1, {comparer:o})
end ignoring
return output
end largestAnagramGroups
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 largestAnagramGroups(wordList)</syntaxhighlight>
{{output}}
<syntaxhighlight lang="applescript">{{"abel", "able", "bale", "bela", "elba"}, {"alger", "glare", "lager", "large", "regal"}, {"angel", "angle", "galen", "glean", "lange"}, {"caret", "carte", "cater", "crate", "trace"}, {"elan", "lane", "lean", "lena", "neal"}, {"evil", "levi", "live", "veil", "vile"}}</syntaxhighlight>
=={{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 anagram.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ MAXI, 40000
.equ BUFFERSIZE, 300000
.equ READ, 3 @ system call
.equ OPEN, 5 @ system call
.equ CLOSE, 6 @ system call
.equ O_RDWR, 0x0002 @ open for reading and writing
/*********************************/
/* Initialized data */
/*********************************/
.data
szFileName: .asciz "./listword.txt"
szMessErreur: .asciz "FILE ERROR."
szCarriageReturn: .asciz "\n"
szMessSpace: .asciz " "
ptBuffer1: .int sBuffer1
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
ptTabBuffer: .skip 4 * MAXI
ptTabAna: .skip 4 * MAXI
tbiCptAna: .skip 4 * MAXI
iNBword: .skip 4
sBuffer: .skip BUFFERSIZE
sBuffer1: .skip BUFFERSIZE
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
mov r4,#0 @ loop indice
ldr r0,iAdrszFileName @ file name
mov r1,#O_RDWR @ flags
mov r2,#0 @ mode
mov r7,#OPEN @
svc 0
cmp r0,#0 @ error open
ble 99f
mov r8,r0 @ FD save Fd
ldr r1,iAdrsBuffer @ buffer address
ldr r2,iSizeBuf @ buffersize
mov r7, #READ
svc 0
cmp r0,#0 @ error read ?
blt 99f
mov r5,r0 @ save size read bytes
ldr r4,iAdrsBuffer @ buffer address
ldr r0,iAdrsBuffer @ start word address
mov r2,#0
mov r1,#0 @ word length
1:
cmp r2,r5
bge 2f
ldrb r3,[r4,r2]
cmp r3,#0xD @ end word ?
addne r1,r1,#1 @ increment word length
addne r2,r2,#1 @ increment indice
bne 1b @ and loop
mov r3,#0
strb r3,[r4,r2] @ store final zero
bl anaWord @ sort word letters
add r2,r2,#2 @ jump OD and 0A
add r0,r4,r2 @ new address begin word
mov r1,#0 @ init length
b 1b @ and loop
2:
mov r3,#0 @ last word
strb r3,[r4,r2]
bl anaWord
mov r0,r8 @ file Fd
mov r7, #CLOSE
svc 0
cmp r0,#0 @ error close ?
blt 99f
ldr r0,iAdrptTabAna @ address sorted string area
mov r1,#0 @ first indice
ldr r2,iAdriNBword
ldr r2,[r2] @ last indice
ldr r3,iAdrptTabBuffer @ address sorted string area
bl triRapide @ quick sort
ldr r4,iAdrptTabAna @ address sorted string area
ldr r7,iAdrptTabBuffer @ address sorted string area
ldr r10,iAdrtbiCptAna @ address counter occurences
mov r9,r2 @ size word array
mov r8,#0 @ indice first occurence
ldr r3,[r4,r8,lsl #2] @ load first value
mov r2,#1 @ loop indice
mov r6,#0 @ counter
mov r12,#0 @ counter value max
3:
ldr r5,[r4,r2,lsl #2] @ load next value
mov r0,r3
mov r1,r5
bl comparStrings
cmp r0,#0 @ sorted strings equal ?
bne 4f
add r6,r6,#1 @ yes increment counter
b 5f
4: @ no
str r6,[r10,r8,lsl #2] @ store counter in first occurence
cmp r6,r12 @ counter > value max
movgt r12,r6 @ yes counter -> value max
mov r6,#0 @ raz counter
mov r8,r2 @ init index first occurence
mov r3,r5 @ init value first occurence
5:
add r2,r2,#1 @ increment indice
cmp r2,r9 @ end word array ?
blt 3b @ no -> loop
mov r2,#0 @ raz indice
6: @ display loop
ldr r6,[r10,r2,lsl #2] @ load counter
cmp r6,r12 @ equal to max value ?
bne 8f
ldr r0,[r7,r2,lsl #2] @ load address first word
bl affichageMess
add r3,r2,#1 @ increment new indixe
mov r4,#0 @ counter
7:
ldr r0,iAdrszMessSpace
bl affichageMess
ldr r0,[r7,r3,lsl #2] @ load address other word
bl affichageMess
add r3,r3,#1 @ increment indice
add r4,r4,#1 @ increment counter
cmp r4,r6 @ max value ?
blt 7b @ no loop
ldr r0,iAdrszCarriageReturn
bl affichageMess
8:
add r2,r2,#1 @ increment indice
cmp r2,r9 @ maxi ?
blt 6b @ no -> loop
b 100f
99: @ display error
ldr r1,iAdrszMessErreur
bl displayError
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrszFileName: .int szFileName
iAdrszMessErreur: .int szMessErreur
iAdrsBuffer: .int sBuffer
iSizeBuf: .int BUFFERSIZE
iAdrszMessSpace: .int szMessSpace
iAdrtbiCptAna: .int tbiCptAna
/******************************************************************/
/* analizing word */
/******************************************************************/
/* r0 word address */
/* r1 word length */
anaWord:
push {r1-r6,lr}
mov r5,r0
mov r6,r1
ldr r1,iAdrptTabBuffer
ldr r2,iAdriNBword
ldr r3,[r2]
str r0,[r1,r3,lsl #2]
ldr r1,iAdrptTabAna
ldr r4,iAdrptBuffer1
ldr r0,[r4]
add r6,r6,r0
add r6,r6,#1
str r6,[r4]
str r0,[r1,r3,lsl #2]
add r3,r3,#1
str r3,[r2]
mov r1,r0
mov r0,r5
bl triLetters @ sort word letters
mov r2,#0
100:
pop {r1-r6,pc}
iAdrptTabBuffer: .int ptTabBuffer
iAdrptTabAna: .int ptTabAna
iAdriNBword: .int iNBword
iAdrptBuffer1: .int ptBuffer1
/******************************************************************/
/* sort word letters */
/******************************************************************/
/* r0 address begin word */
/* r1 address recept array */
triLetters:
push {r1-r7,lr}
mov r2,#0
1:
ldrb r3,[r0,r2] @ load letter
cmp r3,#0 @ end word ?
beq 6f
cmp r2,#0 @ first letter ?
bne 2f
strb r3,[r1,r2] @ yes store in first position
add r2,r2,#1 @ increment indice
b 1b @ and loop
2:
mov r4,#0
3: @ begin loop to search insertion position
ldrb r5,[r1,r4] @ load letter
cmp r3,r5 @ compare
blt 4f @ to low -> insertion
add r4,r4,#1 @ increment indice
cmp r4,r2 @ compare to letters number in place
blt 3b @ search loop
strb r3,[r1,r2] @ else store in last position
add r2,r2,#1
b 1b @ and loop
4: @ move first letters in one position
sub r6,r2,#1 @ start indice
5:
ldrb r5,[r1,r6] @ load letter
add r7,r6,#1 @ store indice - 1
strb r5,[r1,r7] @ store letter
sub r6,r6,#1 @ decrement indice
cmp r6,r4 @ end ?
bge 5b @ no loop
strb r3,[r1,r4] @ else store letter in free position
add r2,r2,#1
b 1b @ and loop
6:
mov r3,#0 @ final zéro
strb r3,[r1,r2]
100:
pop {r1-r7,pc}
/***************************************************/
/* Appel récursif Tri Rapide quicksort */
/***************************************************/
/* r0 contains the address of table */
/* r1 contains index of first item */
/* r2 contains the number of elements > 0 */
/* r3 contains the address of table 2 */
triRapide:
push {r2-r6,lr} @ save registers
mov r6,r3
sub r2,#1 @ last item index
cmp r1,r2 @ first > last ?
bge 100f @ yes -> end
mov r4,r0 @ save r0
mov r5,r2 @ save r2
mov r3,r6
bl partition1 @ cutting into 2 parts
mov r2,r0 @ index partition
mov r0,r4 @ table address
bl triRapide @ sort lower part
mov r0,r4 @ table address
add r1,r2,#1 @ index begin = index partition + 1
add r2,r5,#1 @ number of elements
bl triRapide @ sort higter part
100: @ end function
pop {r2-r6,lr} @ restaur registers
bx lr @ return
/******************************************************************/
/* Partition table elements */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains index of first item */
/* r2 contains index of last item */
/* r3 contains the address of table 2 */
partition1:
push {r1-r12,lr} @ save registers
mov r8,r0 @ save address table 2
mov r9,r1
ldr r10,[r8,r2,lsl #2] @ load string address last index
mov r4,r9 @ init with first index
mov r5,r9 @ init with first index
1: @ begin loop
ldr r6,[r8,r5,lsl #2] @ load string address
mov r0,r6
mov r1,r10
bl comparStrings
cmp r0,#0
ldrlt r7,[r8,r4,lsl #2] @ if < swap value table
strlt r6,[r8,r4,lsl #2]
strlt r7,[r8,r5,lsl #2]
ldrlt r7,[r3,r4,lsl #2] @ swap array 2
ldrlt r12,[r3,r5,lsl #2]
strlt r7,[r3,r5,lsl #2]
strlt r12,[r3,r4,lsl #2]
addlt r4,#1 @ and increment index 1
add r5,#1 @ increment index 2
cmp r5,r2 @ end ?
blt 1b @ no -> loop
ldr r7,[r8,r4,lsl #2] @ swap value
str r10,[r8,r4,lsl #2]
str r7,[r8,r2,lsl #2]
ldr r7,[r3,r4,lsl #2] @ swap array 2
ldr r12,[r3,r2,lsl #2]
str r7,[r3,r2,lsl #2]
str r12,[r3,r4,lsl #2]
mov r0,r4 @ return index partition
100:
pop {r1-r12,lr}
bx lr
/************************************/
/* Strings case sensitive comparisons */
/************************************/
/* r0 et r1 contains the address of strings */
/* return 0 in r0 if equals */
/* return -1 if string r0 < string r1 */
/* return 1 if string r0 > string r1 */
comparStrings:
push {r1-r4} @ save des registres
mov r2,#0 @ counter
1:
ldrb r3,[r0,r2] @ byte string 1
ldrb r4,[r1,r2] @ byte string 2
cmp r3,r4
movlt r0,#-1 @ small
movgt r0,#1 @ greather
bne 100f @ not equals
cmp r3,#0 @ 0 end string
moveq r0,#0 @ equals
beq 100f @ end string
add r2,r2,#1 @ else add 1 in counter
b 1b @ and loop
100:
pop {r1-r4}
bx lr
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
<pre>
bale able bela abel elba
cater carte crate caret trace
galen glean angle lange angel
regal glare alger lager large
lena lane lean elan neal
veil levi live vile evil
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="rebol">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
]
loop select values anagrams 'x [5 =< size x] 'words ->
print join.with:", " words</syntaxhighlight>
{{out}}
<pre>abel, able, bale, bela, elba
alger, glare, lager, large, regal
angel, angle, galen, glean, lange
caret, carte, cater, crate, trace
elan, lane, lean, lena, neal
evil, levi, live, veil, vile</pre>
=={{header|AutoHotkey}}==
Following code should work for AHK 1.0.* and 1.1* versions:
<
Loop, Parse, Contents, % "`n", % "`r"
{ ; parsing each line of the file we just read
Line 549 ⟶ 1,482:
Else ; output only those sets of letters that scored the maximum amount of common words
Break
MsgBox, % ClipBoard := SubStr(var_Output,2) ; the result is also copied to the clipboard</
{{out}}
<pre>
Line 561 ⟶ 1,494:
=={{header|AWK}}==
<
# syntax: GAWK -f JUMBLEA.AWK UNIXDICT.TXT
{ for (i=1; i<=NF; i++) {
Line 586 ⟶ 1,519:
}
return(str)
}</
{{out}}
<pre>
Line 599 ⟶ 1,532:
Alternatively, non-POSIX version:
{{works with|gawk}}
<
{ patsplit($0, chars, ".")
Line 615 ⟶ 1,548:
if (count[i] == countMax)
print substr(accum[i], 2)
}</
=={{header|
==={{header|BaCon}}===
<syntaxhighlight lang="freebasic">OPTION COLLAPSE TRUE
DECLARE idx$ ASSOC STRING
Line 637 ⟶ 1,571:
FOR y = 0 TO x-1
IF MaxCount = AMOUNT(idx$(n$[y])) THEN PRINT n$[y], ": ", idx$(n$[y])
NEXT</
{{out}}
<pre>
Line 650 ⟶ 1,584:
</pre>
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<
sort% = FN_sortinit(0,0)
Line 715 ⟶ 1,649:
C% = LEN(word$)
CALL sort%, char&(0)
= $$^char&(0)</
{{out}}
<pre>
Line 725 ⟶ 1,659:
evil levi live veil vile
</pre>
=={{header|BQN}}==
<syntaxhighlight lang="bqn">words ← •FLines "unixdict.txt"
•Show¨{𝕩/˜(⊢=⌈´)≠¨𝕩} (⊐∧¨)⊸⊔ words</syntaxhighlight>
<syntaxhighlight lang="bqn">⟨ "abel" "able" "bale" "bela" "elba" ⟩
⟨ "alger" "glare" "lager" "large" "regal" ⟩
⟨ "angel" "angle" "galen" "glean" "lange" ⟩
⟨ "caret" "carte" "cater" "crate" "trace" ⟩
⟨ "elan" "lane" "lean" "lena" "neal" ⟩
⟨ "evil" "levi" "live" "veil" "vile" ⟩</syntaxhighlight>
Assumes that <code>unixdict.txt</code> is in the same folder. The [[mlochbaum/BQN|JS implementation]] must be run in Node.js to have access to the filesystem.
<code>(⊐∧¨)⊸⊔</code> is an expression which sorts all words and groups based on them.
=={{header|Bracmat}}==
Line 730 ⟶ 1,679:
This solution makes extensive use of Bracmat's computer algebra mechanisms. A trick is needed to handle words that are merely repetitions of a single letter, such as <code>iii</code>. That's why the variabe <code>sum</code> isn't initialised with <code>0</code>, but with a non-number, in this case the empty string. Also te correct handling of characters 0-9 needs a trick so that they are not numerically added: they are prepended with a non-digit, an <code>N</code> in this case. After completely traversing the word list, the program writes a file <code>product.txt</code> that can be visually inspected.
The program is not fast. (Minutes rather than seconds.)
<
& 1:?product
& whl
Line 757 ⟶ 1,706:
| out$!group
)
);</
{{out}}
<pre> abel+able+bale+bela+elba
Line 767 ⟶ 1,716:
=={{header|C}}==
<
#include <stdlib.h>
#include <string.h>
Line 926 ⟶ 1,875:
fclose(f1);
return 0;
}</
{{out}} (less than 1 second on old P500)
<pre>5:vile, veil, live, levi, evil,
Line 936 ⟶ 1,885:
</pre>
A much shorter version with no fancy data structures:
<
#include <stdlib.h>
#include <string.h>
Line 1,036 ⟶ 1,985:
close(fd);
return 0;
}</
{{out}}
<pre>
Line 1,044 ⟶ 1,993:
alger glare lager large regal
elan lane lean lena neal
evil levi live veil vile
</pre>
=={{header|C sharp|C#}}==
<syntaxhighlight lang="csharp">using System;
using System.IO;
using System.Linq;
using System.Net;
using System.Text.RegularExpressions;
namespace Anagram
{
class Program
{
const string DICO_URL = "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt";
static void Main( string[] args )
{
WebRequest request = WebRequest.Create(DICO_URL);
string[] words;
using (StreamReader sr = new StreamReader(request.GetResponse().GetResponseStream(), true)) {
words = Regex.Split(sr.ReadToEnd(), @"\r?\n");
}
var groups = from string w in words
group w by string.Concat(w.OrderBy(x => x)) into c
group c by c.Count() into d
orderby d.Key descending
select d;
foreach (var c in groups.First()) {
Console.WriteLine(string.Join(" ", c));
}
}
}
}</syntaxhighlight>
{{out}}
<pre>
abel able bale bela elba
alger glare lager large regal
angel angle galen glean lange
caret carte cater crate trace
elan lane lean lena neal
evil levi live veil vile
</pre>
=={{header|C++}}==
<
#include <fstream>
#include <string>
Line 1,082 ⟶ 2,072:
}
return 0;
}</
{{out}}
abel, able, bale, bela, elba,
Line 1,090 ⟶ 2,080:
elan, lane, lean, lena, neal,
evil, levi, live, veil, vile,
=={{header|Clojure}}==
Assume ''wordfile'' is the path of the local file containing the words. This code makes a map (''groups'') whose keys are sorted letters and values are lists of the key's anagrams. It then determines the length of the longest list, and prints out all the lists of that length.
<
(def groups
Line 1,143 ⟶ 2,092:
maxlength (count (first wordlists))]
(doseq [wordlist (take-while #(= (count %) maxlength) wordlists)]
(println wordlist))</
<
(->> (slurp "http://
clojure.string/split-lines
(group-by sort)
Line 1,160 ⟶ 2,109:
;; ["evil" "levi" "live" "veil" "vile"]
;; ["abel" "able" "bale" "bela" "elba"])
</syntaxhighlight>
=={{header|CLU}}==
<syntaxhighlight lang="clu">% Keep a list of anagrams
anagrams = cluster is new, add, largest_size, sets
anagram_set = struct[letters: string, words: array[string]]
rep = array[anagram_set]
new = proc () returns (cvt)
return(rep$[])
end new
% Sort the letters in a string
sort = proc (s: string) returns (string)
chars: array[int] := array[int]$fill(0,256,0) % Assuming ASCII here
for c: char in string$chars(s) do
i: int := char$c2i(c)
chars[i] := chars[i] + 1
end
sorted: array[char] := array[char]$predict(1,string$size(s))
for i: int in array[int]$indexes(chars) do
for j: int in int$from_to(1,chars[i]) do
array[char]$addh(sorted,char$i2c(i))
end
end
return(string$ac2s(sorted))
end sort
% Add a word
add = proc (a: cvt, s: string)
letters: string := sort(s)
as: anagram_set
begin
for t_as: anagram_set in rep$elements(a) do
if t_as.letters = letters then
as := t_as
exit found
end
end
as := anagram_set${letters: letters, words: array[string]$[]}
rep$addh(a, as)
end except when found: end
array[string]$addh(as.words, s)
end add
% Find the size of the largest set
largest_size = proc (a: cvt) returns (int)
size: int := 0
for as: anagram_set in rep$elements(a) do
cur: int := array[string]$size(as.words)
if cur > size then size := cur end
end
return(size)
end largest_size
% Yield all sets of a given size
sets = iter (a: cvt, s: int) yields (sequence[string])
for as: anagram_set in rep$elements(a) do
if array[string]$size(as.words) = s then
yield(sequence[string]$a2s(as.words))
end
end
end sets
end anagrams
start_up = proc ()
an: anagrams := anagrams$new()
dict: stream := stream$open(file_name$parse("unixdict.txt"), "read")
while true do
anagrams$add(an, stream$getl(dict))
except when end_of_file: break end
end
stream$close(dict)
po: stream := stream$primary_output()
max: int := anagrams$largest_size(an)
stream$putl(po, "Largest amount of anagrams per set: " || int$unparse(max))
stream$putl(po, "")
for words: sequence[string] in anagrams$sets(an, max) do
for word: string in sequence[string]$elements(words) do
stream$putleft(po, word, 7)
end
stream$putl(po, "")
end
end start_up</syntaxhighlight>
{{out}}
<pre>Largest amount of anagrams per set: 5
abel able bale bela elba
alger glare lager large regal
angel angle galen glean lange
caret carte cater crate trace
elan lane lean lena neal
evil levi live veil vile</pre>
=={{header|COBOL}}==
Tested with GnuCOBOL 2.0. ALLWORDS output display trimmed for width.
<
*> wget http://
*> or visit https://sourceforge.net/projects/souptonuts/files
*> or snag ftp://ftp.openwall.com/pub/wordlists/all.gz
Line 1,407 ⟶ 2,450:
.
end program anagrams.</
{{out}}
Line 1,439 ⟶ 2,482:
=={{header|CoffeeScript}}==
<
show_large_anagram_sets = (word_lst) ->
Line 1,458 ⟶ 2,501:
get_word_list = (process) ->
options =
host: "
path: "/pub/wordlists/unixdict.txt"
Line 1,469 ⟶ 2,512:
req.end()
get_word_list show_large_anagram_sets</
{{out}}
<
[ 'abel', 'able', 'bale', 'bela', 'elba' ]
[ 'alger', 'glare', 'lager', 'large', 'regal' ]
Line 1,477 ⟶ 2,520:
[ 'caret', 'carte', 'cater', 'crate', 'trace' ]
[ 'elan', 'lane', 'lean', 'lena', 'neal' ]
[ 'evil', 'levi', 'live', 'veil', 'vile' ]</
=={{header|Common Lisp}}==
{{libheader|DRAKMA}} to retrieve the wordlist.
<
(let ((words (drakma:http-request url :want-stream t))
(wordsets (make-hash-table :test 'equalp)))
Line 1,503 ⟶ 2,546:
else if (eql (car pair) maxcount)
do (push (cdr pair) maxwordsets)
finally (return (values maxwordsets maxcount)))))</
Evalutating
<
(pprint wordsets)
(print count))</
{{out}}
<pre>(("vile" "veil" "live" "levi" "evil")
Line 1,517 ⟶ 2,560:
5</pre>
Another method, assuming file is local:
<
(with-open-file (stream file)
(loop with w = "" while w collect (setf w (read-line stream nil)))))
Line 1,535 ⟶ 2,578:
longest))
(format t "~{~{~a ~}~^~%~}" (anagram "unixdict.txt"))</
{{out}}
<pre>elba bela bale able abel
Line 1,546 ⟶ 2,589:
=={{header|Component Pascal}}==
BlackBox Component Builder
<
MODULE BbtAnagrams;
IMPORT StdLog,Files,Strings,Args;
Line 1,722 ⟶ 2,765:
END BbtAnagrams.
</syntaxhighlight>
Execute:^Q BbtAnagrams.DoProcess unixdict.txt~<br/>
{{out}}
Line 1,735 ⟶ 2,778:
caret trace crate cater carte
</pre>
=={{header|Crystal}}==
{{trans|Ruby}}
<syntaxhighlight lang="ruby">require "http/client"
response = HTTP::Client.get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
if response.body?
words : Array(String) = response.body.split
anagram = {} of String => Array(String)
words.each do |word|
key = word.split("").sort.join
if !anagram[key]?
anagram[key] = [word]
else
anagram[key] << word
end
end
count = anagram.values.map { |ana| ana.size }.max
anagram.each_value { |ana| puts ana if ana.size >= count }
end
</syntaxhighlight>
{{out}}
<pre>
["abel", "able", "bale", "bela", "elba"]
["alger", "glare", "lager", "large", "regal"]
["angel", "angle", "galen", "glean", "lange"]
["caret", "carte", "cater", "crate", "trace"]
["elan", "lane", "lean", "lena", "neal"]
["evil", "levi", "live", "veil", "vile"]
</pre>
=={{header|D}}==
===Short Functional Version===
<
void main() {
Line 1,745 ⟶ 2,826:
immutable m = an.byValue.map!q{ a.length }.reduce!max;
writefln("%(%s\n%)", an.byValue.filter!(ws => ws.length == m));
}</
{{out}}
<pre>["caret", "carte", "cater", "crate", "trace"]
Line 1,757 ⟶ 2,838:
===Faster Version===
Less safe, same output.
<
import std.stdio, std.algorithm, std.file, std.string;
Line 1,770 ⟶ 2,851:
immutable m = anags.byValue.map!q{ a.length }.reduce!max;
writefln("%(%-(%s %)\n%)", anags.byValue.filter!(ws => ws.length == m));
}</
Runtime: about 0.06 seconds.
=={{header|Delphi}}==
{{libheader| System.SysUtils}}
{{libheader| System.Classes}}
{{libheader| System.Diagnostics}}
<syntaxhighlight lang="delphi">
program AnagramsTest;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.Classes,
System.Diagnostics;
function Sort(s: string): string;
var
c: Char;
i, j, aLength: Integer;
begin
aLength := s.Length;
if aLength = 0 then
exit('');
Result := s;
for i := 1 to aLength - 1 do
for j := i + 1 to aLength do
if result[i] > result[j] then
begin
c := result[i];
result[i] := result[j];
result[j] := c;
end;
end;
function IsAnagram(s1, s2: string): Boolean;
begin
if s1.Length <> s2.Length then
exit(False);
Result := Sort(s1) = Sort(s2);
end;
function Split(s: string; var Count: Integer; var words: string): Boolean;
var
sCount: string;
begin
sCount := s.Substring(0, 4);
words := s.Substring(5);
Result := TryStrToInt(sCount, Count);
end;
function CompareLength(List: TStringList; Index1, Index2: Integer): Integer;
begin
result := List[Index1].Length - List[Index2].Length;
if Result = 0 then
Result := CompareText(Sort(List[Index2]), Sort(List[Index1]));
end;
var
Dict: TStringList;
i, j, Count, MaxCount, WordLength, Index: Integer;
words: string;
StopWatch: TStopwatch;
begin
StopWatch := TStopwatch.Create;
StopWatch.Start;
Dict := TStringList.Create();
Dict.LoadFromFile('unixdict.txt');
Dict.CustomSort(CompareLength);
Index := 0;
words := Dict[Index];
Count := 1;
while Index + Count < Dict.Count do
begin
if IsAnagram(Dict[Index], Dict[Index + Count]) then
begin
words := words + ',' + Dict[Index + Count];
Dict[Index + Count] := '';
inc(Count);
end
else
begin
Dict[Index] := format('%.4d', [Count]) + ',' + words;
inc(Index, Count);
words := Dict[Index];
Count := 1;
end;
end;
// The last one not match any one
if not Dict[Dict.count - 1].IsEmpty then
Dict.Delete(Dict.count - 1);
Dict.Sort;
while Dict[0].IsEmpty do
Dict.Delete(0);
StopWatch.Stop;
Writeln(Format('Time pass: %d ms [i7-4500U Windows 7]', [StopWatch.ElapsedMilliseconds]));
Split(Dict[Dict.count - 1], MaxCount, words);
writeln(#10'The anagrams that contain the most words, has ', MaxCount, ' words:'#10);
writeln('Words found:'#10);
Writeln(' ', words);
for i := Dict.Count - 2 downto 0 do
begin
Split(Dict[i], Count, words);
if Count = MaxCount then
Writeln(' ', words)
else
Break;
end;
Dict.Free;
Readln;
end.
</syntaxhighlight>
{{out}}
<pre>
Time pass: 700 ms [i7-4500U Windows 7]
The anagrams that contain the most words, has 5 words:
Words found:
veil,live,vile,evil,levi
trace,crate,cater,carte,caret
regal,glare,large,lager,alger
neal,lean,elan,lane,lena
glean,angel,galen,angle,lange
able,bale,abel,bela,elba
</pre>
=={{header|E}}==
<
when (def wordText := <http://
def words := wordText.split("\n")
Line 1,795 ⟶ 3,025:
println(anagramGroup.snapshot())
}
}</
=={{header|EchoLisp}}==
For a change, we will use the french dictionary - '''(lib 'dico.fr)''' - delivered within EchoLisp.
<
(require 'struct)
(require 'hash)
Line 1,835 ⟶ 3,065:
(cdr h))
))
</syntaxhighlight>
{{out}}
<
(length mots-français)
→ 209315
Line 1,847 ⟶ 3,077:
→ { alisen enlias enlisa ensila islaen islean laines lianes salien saline selina }
</syntaxhighlight>
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
class
ANAGRAMS
Line 1,938 ⟶ 3,168:
end
</syntaxhighlight>
{{out}}
<pre>
Line 1,951 ⟶ 3,181:
=={{header|Ela}}==
{{trans|Haskell}}
<
groupon f x y = f x == f y
Line 1,964 ⟶ 3,194:
let wix = groupBy (groupon fst) << sort $ zip (map sort words) words
let mxl = maximum $ map length wix
mapM_ (putLn << map snd) << filter ((==mxl) << length) $ wix</
{{out}}<pre>["vile","veil","live","levi","evil"]
Line 1,975 ⟶ 3,205:
=={{header|Elena}}==
ELENA
<
import system'calendar;
import system'io;
import system'collections;
Line 1,982 ⟶ 3,213:
import extensions'routines;
import extensions'text;
import algorithms;
extension op
Line 1,991 ⟶ 3,223:
public program()
{
var start := now;
auto dictionary := new Map<string,object>();
File.assign("unixdict.txt").forEachLine::(word)
{
var key := word.normalized();
Line 2,003 ⟶ 3,237:
};
item.append
};
dictionary.Values
.
.top
.forEach::(pair){ console.printLine(pair.Item2) };
var end := now;
var diff := end - start;
console.printLine("Time elapsed in msec:",diff.Milliseconds);
console.readChar()
}</
{{out}}
<pre>
abel,able,bale,bela,elba
alger,glare,lager,large,regal
evil,levi,live,veil,vile
elan,lane,lean,lena,neal
caret,carte,cater,crate,trace
angel,angle,galen,glean,lange
are,ear,era,rae
dare,dear,erda,read
diet,edit,tide,tied
cereus,recuse,rescue,secure
ames,mesa,same,seam
emit,item,mite,time
amen,mane,mean,name
enol,leon,lone,noel
esprit,priest,sprite,stripe
beard,bread,debar,debra
hare,hear,hera,rhea
apt,pat,pta,tap
aires,aries,arise,raise
keats,skate,stake,steak
</pre>
=={{header|Elixir}}==
<
def find(file) do
File.read!(file)
Line 2,053 ⟶ 3,293:
end
Anagrams.find("unixdict.txt")</
{{out}}
Line 2,066 ⟶ 3,306:
The same output, using <code>File.Stream!</code> to generate <code>tuples</code> containing the word and it's sorted value as <code>strings</code>.
<
|> Stream.map(&String.strip &1)
|> Enum.group_by(&String.codepoints(&1) |> Enum.sort)
Line 2,073 ⟶ 3,313:
|> Enum.max
|> elem(1)
|> Enum.each(fn n -> Enum.sort(n) |> Enum.join(" ") |> IO.puts end)</
{{out}}
Line 2,084 ⟶ 3,324:
abel able bale bela elba
</pre>
=={{header|Emacs Lisp}}==
<syntaxhighlight lang="lisp">
(defun code-letters (str)
"Sort STR into alphabetized list of individual letters."
(sort (split-string str "" t) #'string<))
(defun code-letters-to-string (str)
"Sort STR alphabetically and combine into one string."
(apply #'concat (code-letters str)))
(defun remove-periods (str)
"Remove periods (full stops) from STR."
(string-replace "." "" str))
(defun list-pair (str)
"Create paired list from STR, STR (unchanged) and alphabetized order of STR."
;; Remove periods from alphabetized order to make regex matching easier
(let ((letter-list (remove-periods (code-letters-to-string str))))
(list letter-list str)))
(defun pair-up (words)
"Make list of lists of paired words, one alphabetized one original."
(let ((paired-list)
(temp-pair))
(dolist (word words)
(setq temp-pair (list-pair word))
(push temp-pair paired-list))
paired-list))
(defun create-list-of-numbers (my-list)
"Create list of numbers from MY-LIST."
(let ((list-of-numbers))
(dolist (one-pair my-list)
(push (car one-pair) list-of-numbers))
list-of-numbers))
(defun get-largest-number (my-list)
"Find largest number in MY-LIST."
(let ((list-of-numbers))
(setq list-of-numbers (create-list-of-numbers my-list))
(apply #'max list-of-numbers)))
(defun make-list-matching-words (coded-word-and-original number-and-code-pair)
"List original words whose code matches code in NUMBER-AND-CODE-PAIR."
(dolist (word-pair coded-word-and-original)
;; test if coded word in CODED-WORD-AND-ORIGINAL matches
;; coded word in NUMBER-AND-CODE-PAIR
(when (string= (nth 0 word-pair) (nth 1 number-and-code-pair))
;; insert the original word
(insert (format "%s " (nth 1 word-pair)))))
(insert "\n"))
(defun count-anagrams ()
"Count the number of anagrams in file wordlist.txt"
(let ((coded-word-and-original)
(just-coded-words)
(unique-coded-words)
(count-and-code)
(number-of-anagrams)
(largest-number))
;; Path below needs to be adapted to individual case
(find-file "~/Documents/Elisp/wordlist.txt")
(beginning-of-buffer)
;; create list of lists of coded words and originals
(setq coded-word-and-original (pair-up (split-string (buffer-string) "\n")))
(find-file "temp-all-coded")
(erase-buffer)
(dolist (number-and-code-pair coded-word-and-original)
;; make list of just the coded words
(push (nth 0 number-and-code-pair) just-coded-words))
(dolist (one-word just-coded-words)
;; write list of coded words to buffer for later processing
(insert (format "%s\n" one-word)))
;; create a list of coded words with no repetitions
(setq unique-coded-words (seq-uniq just-coded-words))
(dolist (one-code unique-coded-words)
(find-file "temp-all-coded")
(beginning-of-buffer)
;; count the number of times ONE-CODE appears in buffer
(setq number-of-anagrams (how-many (format "^%s$" one-code)))
(if (>= number-of-anagrams 1) ; eliminate "words" of zero length
(push (list number-of-anagrams one-code) count-and-code)))
(find-file "anagram-listing")
(erase-buffer)
(setq largest-number (get-largest-number count-and-code))
(dolist (number-and-code-pair count-and-code)
;; when the number in NUMBER-AND-CODE-PAIR = largest number of anagrams
(when (= (nth 0 number-and-code-pair) largest-number)
(make-list-matching-words coded-word-and-original number-and-code-pair)))))
</syntaxhighlight>
{{out}}
(count-anagrams)
<pre>
vile veil live levi evil
neal lena lean lane elan
trace crate cater carte caret
lange glean galen angle angel
regal large lager glare alger
elba bela bale able abel
</pre>
=={{header|Erlang}}==
The function fetch/2 is used to solve [[Anagrams/Deranged_anagrams]]. Please keep backwards compatibility when editing. Or update the other module, too.
<
-compile(export_all).
Line 2,116 ⟶ 3,459:
get_value([], _, _, L) ->
L.
</syntaxhighlight>
{{out}}
<pre>
Line 2,130 ⟶ 3,473:
=={{header|Euphoria}}==
<
function compare_keys(sequence a, sequence b)
Line 2,178 ⟶ 3,521:
puts(1,"\n")
end if
end for</
{{out}}
<pre>abel bela bale elba able
Line 2,190 ⟶ 3,533:
=={{header|F Sharp|F#}}==
Read the lines in the dictionary, group by the sorted letters in each word, find the length of the longest sets of anagrams, extract the longest sequences of words sharing the same letters (i.e. anagrams):
<
Seq.map snd xss |> Seq.filter (Seq.length >> ( = ) (Seq.map (snd >> Seq.length) xss |> Seq.max))</
Note that it is necessary to convert the sorted letters in each word from sequences to arrays because the groupBy function uses the default comparison and sequences do not compare structurally (but arrays do in F#).
Takes 0.8s to return:
<
seq
[seq ["abel"; "able"; "bale"; "bela"; "elba"];
Line 2,202 ⟶ 3,545:
seq ["caret"; "carte"; "cater"; "crate"; "trace"];
seq ["elan"; "lane"; "lean"; "lena"; "neal"];
seq ["evil"; "levi"; "live"; "veil"; "vile"]]</
=={{header|Fantom}}==
<
{
// take given word and return a string rearranging characters in order
Line 2,436 ⟶ 3,590:
}
}
}</
{{out}}
Line 2,447 ⟶ 3,601:
</pre>
==
This program:
<
module anagram_routines
!***************************************************************************************
Line 2,623 ⟶ 3,777:
!***************************************************************************************
end program main
!***************************************************************************************</
{{out}}
Line 2,638 ⟶ 3,792:
[Runtime = 6.897 sec]
</pre>
=={{header|FBSL}}==
'''A little bit of cheating: literatim re-implementation of C solution in FBSL's Dynamic C layer.'''
<syntaxhighlight lang="c">#APPTYPE CONSOLE
DIM gtc = GetTickCount()
Anagram()
PRINT "Done in ", (GetTickCount() - gtc) / 1000, " seconds"
PAUSE
DYNC Anagram()
#include <windows.h>
#include <stdio.h>
char* sortedWord(const char* word, char* wbuf)
{
char* p1, *p2, *endwrd;
char t;
int swaps;
strcpy(wbuf, word);
endwrd = wbuf + strlen(wbuf);
do {
swaps = 0;
p1 = wbuf; p2 = endwrd - 1;
while (p1 < p2) {
if (*p2 >* p1) {
t = *p2; *p2 = *p1; *p1 = t;
swaps = 1;
}
p1++; p2--;
}
p1 = wbuf; p2 = p1 + 1;
while (p2 < endwrd) {
if (*p2 >* p1) {
t = *p2; *p2 = *p1; *p1 = t;
swaps = 1;
}
p1++; p2++;
}
} while (swaps);
return wbuf;
}
static short cxmap[] = {
0x06, 0x1f, 0x4d, 0x0c, 0x5c, 0x28, 0x5d, 0x0e, 0x09, 0x33, 0x31, 0x56,
0x52, 0x19, 0x29, 0x53, 0x32, 0x48, 0x35, 0x55, 0x5e, 0x14, 0x27, 0x24,
0x02, 0x3e, 0x18, 0x4a, 0x3f, 0x4c, 0x45, 0x30, 0x08, 0x2c, 0x1a, 0x03,
0x0b, 0x0d, 0x4f, 0x07, 0x20, 0x1d, 0x51, 0x3b, 0x11, 0x58, 0x00, 0x49,
0x15, 0x2d, 0x41, 0x17, 0x5f, 0x39, 0x16, 0x42, 0x37, 0x22, 0x1c, 0x0f,
0x43, 0x5b, 0x46, 0x4b, 0x0a, 0x26, 0x2e, 0x40, 0x12, 0x21, 0x3c, 0x36,
0x38, 0x1e, 0x01, 0x1b, 0x05, 0x4e, 0x44, 0x3d, 0x04, 0x10, 0x5a, 0x2a,
0x23, 0x34, 0x25, 0x2f, 0x2b, 0x50, 0x3a, 0x54, 0x47, 0x59, 0x13, 0x57,
};
#define CXMAP_SIZE (sizeof(cxmap) / sizeof(short))
int Str_Hash(const char* key, int ix_max)
{
const char* cp;
short mash;
int hash = 33501551;
for (cp = key; *cp; cp++) {
mash = cxmap[*cp % CXMAP_SIZE];
hash = (hash >>4) ^ 0x5C5CF5C ^ ((hash << 1) + (mash << 5));
hash &= 0x3FFFFFFF;
}
return hash % ix_max;
}
typedef struct sDictWord* DictWord;
struct sDictWord {
const char* word;
DictWord next;
};
typedef struct sHashEntry* HashEntry;
struct sHashEntry {
const char* key;
HashEntry next;
DictWord words;
HashEntry link;
short wordCount;
};
#define HT_SIZE 8192
HashEntry hashTable[HT_SIZE];
HashEntry mostPerms = NULL;
int buildAnagrams(FILE* fin)
{
char buffer[40];
char bufr2[40];
char* hkey;
int hix;
HashEntry he, *hep;
DictWord we;
int maxPC = 2;
int numWords = 0;
while (fgets(buffer, 40, fin)) {
for (hkey = buffer; *hkey && (*hkey != '\n'); hkey++);
*hkey = 0;
hkey = sortedWord(buffer, bufr2);
hix = Str_Hash(hkey, HT_SIZE);
he = hashTable[hix]; hep = &hashTable[hix];
while (he && strcmp(he->key, hkey)) {
hep = &he->next;
he = he->next;
}
if (! he) {
he = (HashEntry)malloc(sizeof(struct sHashEntry));
he->next = NULL;
he->key = strdup(hkey);
he->wordCount = 0;
he->words = NULL;
he->link = NULL;
*hep = he;
}
we = (DictWord)malloc(sizeof(struct sDictWord));
we->word = strdup(buffer);
we->next = he->words;
he->words = we;
he->wordCount++;
if (maxPC < he->wordCount) {
maxPC = he->wordCount;
mostPerms = he;
he->link = NULL;
}
else if (maxPC == he->wordCount) {
he->link = mostPerms;
mostPerms = he;
}
numWords++;
}
printf("%d words in dictionary max ana=%d\n", numWords, maxPC);
return maxPC;
}
void main()
{
HashEntry he;
DictWord we;
FILE* f1;
f1 = fopen("unixdict.txt", "r");
buildAnagrams(f1);
fclose(f1);
f1 = fopen("anaout.txt", "w");
for (he = mostPerms; he; he = he->link) {
fprintf(f1, "%d: ", he->wordCount);
for (we = he->words; we; we = we->next) {
fprintf(f1, "%s, ", we->word);
}
fprintf(f1, "\n");
}
fclose(f1);
}
END DYNC</syntaxhighlight>
{{out}} (2.2GHz Intel Core2 Duo)
<pre>25104 words in dictionary max ana=5
Done in 0.031 seconds
Press any key to continue...</pre>
'''"anaout.txt" listing:'''
<pre>5: vile, veil, live, levi, evil,
5: trace, crate, cater, carte, caret,
5: regal, large, lager, glare, alger,
5: neal, lena, lean, lane, elan,
5: lange, glean, galen, angle, angel,
5: elba, bela, bale, able, abel,</pre>
=={{header|Factor}}==
<syntaxhighlight lang="factor"> "resource:unixdict.txt" utf8 file-lines
[ [ natural-sort >string ] keep ] { } map>assoc sort-keys
[ [ first ] compare +eq+ = ] monotonic-split
dup 0 [ length max ] reduce '[ length _ = ] filter [ values ] map .</syntaxhighlight>
<syntaxhighlight lang="factor">{
{ "abel" "able" "bale" "bela" "elba" }
{ "caret" "carte" "cater" "crate" "trace" }
{ "angel" "angle" "galen" "glean" "lange" }
{ "alger" "glare" "lager" "large" "regal" }
{ "elan" "lane" "lean" "lena" "neal" }
{ "evil" "levi" "live" "veil" "vile" }
}</syntaxhighlight>
=={{header|FreeBASIC}}==
<
Type IndexedWord
Line 2,775 ⟶ 4,118:
Print
Print "Press any key to quit"
Sleep</
{{out}}
Line 2,793 ⟶ 4,136:
=={{header|Frink}}==
<
d = new dict
for w = lines["http://
{
sorted = sort[charList[w]]
}
Line 2,814 ⟶ 4,153:
i = i + 1
}
</syntaxhighlight>
=={{header|FutureBasic}}==
Applications in the latest versions of Macintosh OS X 10.x are sandboxed and require setting special permissions to link to internet files. For illustration purposes here, this code uses the internal Unix dictionary file available
<syntaxhighlight lang="futurebasic">
include "NSLog.incl"
local fn Dictionary as CFArrayRef
CFURLRef url = fn URLFileURLWithPath( @"/usr/share/dict/words" )
CFStringRef string = fn StringWithContentsOfURL( url, NSUTF8StringEncoding, NULL )
end fn = fn StringComponentsSeparatedByString( string, @"\n" )
local fn IsAnagram( wrd1 as CFStringRef, wrd2 as CFStringRef ) as BOOL
NSUInteger i
BOOL result = NO
if ( len(wrd1) != len(wrd2) ) then exit fn
if ( fn StringCompare( wrd1, wrd2 ) == NSOrderedSame ) then exit fn
CFMutableArrayRef mutArr1 = fn MutableArrayWithCapacity(0) : CFMutableArrayRef mutArr2 = fn MutableArrayWithCapacity(0)
for i = 0 to len(wrd1) - 1
MutableArrayAddObject( mutArr1, fn StringWithFormat( @"%C", fn StringCharacterAtIndex( wrd1, i ) ) )
MutableArrayAddObject( mutArr2, fn StringWithFormat( @"%C", fn StringCharacterAtIndex( wrd2, i ) ) )
next
SortDescriptorRef sd = fn SortDescriptorWithKeyAndSelector( NULL, YES, @"caseInsensitiveCompare:" )
if ( fn ArrayIsEqual( fn ArraySortedArrayUsingDescriptors( mutArr1, @[sd] ), fn ArraySortedArrayUsingDescriptors( mutArr2, @[sd] ) ) ) then result = YES
end fn = result
void local fn FindAnagramsInDictionary( wd as CFStringRef, dict as CFArrayRef )
CFStringRef string, temp
CFMutableArrayRef words = fn MutableArrayWithCapacity(0)
if ( fn IsAnagram( lcase( wd ), temp ) ) then MutableArrayAddObject( words, temp )
next
string = fn ArrayComponentsJoinedByString( words, @", " )
NSLogSetTextColor( fn ColorText ) : NSLog( @"Anagrams for %@:", lcase(wd) )
NSLogSetTextColor( fn ColorSystemBlue ) : NSLog(@"%@\n",string)
end fn
void local fn DoIt
CFArrayRef dictionary = fn Dictionary
dispatchglobal
CFStringRef string
CFArrayRef words = @[@"bade",@"abet",@"beast",@"tuba",@"mace",@"scare",@"marine",@"antler",@"spare",@"leading",@"alerted",@"allergy",@"research",@"hustle",@"oriental",@"creationism",@"resistance",@"mountaineer"]
for string in words
fn FindAnagramsInDictionary( string, dictionary )
next
dispatchend
end fn
fn DoIt
HandleEvents
</syntaxhighlight>
Output:
<pre>
Line 2,942 ⟶ 4,232:
</pre>
This version fulfils the task description.
<syntaxhighlight lang="futurebasic">
include "NSLog.incl"
#plist NSAppTransportSecurity @{NSAllowsArbitraryLoads:YES}
local fn Dictionary as CFArrayRef
CFURLRef url = fn URLWithString( @"http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" )
CFStringRef string = fn StringWithContentsOfURL( url, NSUTF8StringEncoding, NULL )
end fn = fn StringComponentsSeparatedByCharactersInSet( string, fn CharacterSetNewlineSet )
local fn TestIndexes( array as CFArrayRef, obj as CFTypeRef, index as NSUInteger, stp as ^BOOL, userData as ptr ) as BOOL
end fn = fn StringIsEqual( obj, userData )
void local fn IndexSetEnumerator( set as IndexSetRef, index as NSUInteger, stp as ^BOOL, userData as ptr )
NSLog(@"\t%@\b",fn ArrayObjectAtIndex( userData, index ))
end fn
void local fn
CFArrayRef words
CFStringRef string, sortedString
IndexSetRef indexes
long i, j, count, indexCount, maxCount = 0, length
CFMutableDictionaryRef anagrams
CFTimeInterval ti
ti = fn CACurrentMediaTime
NSLog(@"Searching...")
// create another word list with sorted letters
words = fn Dictionary
count = len(words)
sortedWords = fn MutableArrayWithCapacity(count)
for string in words
length = len(string)
letters = fn MutableArrayWithCapacity(length)
for i = 0 to length - 1
MutableArrayAddObject( letters, mid(string,i,1) )
next
MutableArraySortUsingSelector( letters, @"compare:" )
sortedString = fn ArrayComponentsJoinedByString( letters, @"" )
MutableArrayAddObject( sortedWords, sortedString )
next
// search for identical sorted words
anagrams = fn MutableDictionaryWithCapacity(0)
for i = 0 to count - 2
j = i + 1
indexes = fn ArrayIndexesOfObjectsAtIndexesPassingTest( sortedWords, fn IndexSetWithIndexesInRange( fn CFRangeMake(j,count-j) ), NSEnumerationConcurrent, @fn TestIndexes, (ptr)sortedWords[i] )
indexCount = len(indexes)
if ( indexCount > maxCount )
maxCount = indexCount
MutableDictionaryRemoveAllObjects( anagrams )
end if
if ( indexCount == maxCount )
MutableDictionarySetValueForKey( anagrams, indexes, words[i] )
end if
next
// show results
NSLogClear
for string in anagrams
NSLog(@"%@\b",string)
indexes = anagrams[string]
IndexSetEnumerateIndexes( indexes, @fn IndexSetEnumerator, (ptr)words )
NSLog(@"")
next
NSLog(@"\nCalculated in %0.6fs",fn CACurrentMediaTime - ti)
end fn
dispatchglobal
fn DoIt
dispatchend
HandleEvents
</syntaxhighlight>
{{out}}
<pre>
alger glare lager large regal
caret carte cater crate trace
elan lane lean lena neal
abel able bale bela elba
evil levi live veil vile
angel angle galen glean lange
Calculated in 2.409008s
</pre>
=={{header|GAP}}==
<
local f, p, L, line, word, words, swords, res, cur, r;
words := [ ];
Line 3,172 ⟶ 4,380:
# [ "alger", "glare", "lager", "large", "regal" ],
# [ "elan", "lane", "lean", "lena", "neal" ],
# [ "evil", "levi", "live", "veil", "vile" ] ]</
=={{header|Go}}==
<
import (
Line 3,186 ⟶ 4,394:
func main() {
r, err := http.Get("http://
if err != nil {
fmt.Println(err)
Line 3,221 ⟶ 4,429:
func (b byteSlice) Len() int { return len(b) }
func (b byteSlice) Swap(i, j int) { b[i], b[j] = b[j], b[i] }
func (b byteSlice) Less(i, j int) bool { return b[i] < b[j] }</
{{out}}
<pre>
Line 3,232 ⟶ 4,440:
</pre>
==
This program:
<
def groups = words.groupBy{ it.toList().sort() }
def bigGroupSize = groups.collect{ it.value.size() }.max()
def isBigAnagram = { it.value.size() == bigGroupSize }
println groups.findAll(isBigAnagram).collect{ it.value }.collect{ it.join(' ') }.join('\n')</
{{out}}
<pre>
Line 3,249 ⟶ 4,457:
</pre>
==
<
groupon f x y = f x == f y
Line 3,259 ⟶ 4,467:
wix = groupBy (groupon fst) . sort $ zip (map sort words) words
mxl = maximum $ map length wix
mapM_ (print . map snd) . filter ((==mxl).length) $ wix</
{{out}}
<
["abel","able","bale","bela","elba"]
["caret","carte","cater","crate","trace"]
Line 3,267 ⟶ 4,475:
["alger","glare","lager","large","regal"]
["elan","lane","lean","lena","neal"]
["evil","levi","live","veil","vile"]</
and we can noticeably speed up the second stage sorting and grouping by packing the String lists of Chars to the Text type:
<
import Data.Ord (comparing)
import Data.Function (on)
Line 3,282 ⟶ 4,490:
mapM_
(print . fmap snd)
(filter ((length (maximumBy (comparing length) ws) ==) . length) ws)</
{{Out}}
<pre>["abel","able","bale","bela","elba"]
Line 3,292 ⟶ 4,500:
=={{header|Icon}} and {{header|Unicon}}==
<
every writeSet(!getLongestAnagramSets())
end
Line 3,325 ⟶ 4,533:
every (s := "") ||:= (find(c := !cset(w),w),c)
return s
end</
Sample run:
<pre>->an <unixdict.txt
Line 3,336 ⟶ 4,544:
-></pre>
==
If the unixdict file has been retrieved and saved in the current directory (for example, using wget):
<
+-----+-----+-----+-----+-----+
|abel |able |bale |bela |elba |
Line 3,351 ⟶ 4,559:
+-----+-----+-----+-----+-----+
|evil |levi |live |veil |vile |
+-----+-----+-----+-----+-----+</
Explanation:
<
This reads in the dictionary and produces a list of boxes. Each box contains one line (one word) from the dictionary.
<
This groups the words into rows where anagram equivalents appear in the same row. In other words, creates a copy of the original list where the characters contained in each box have been sorted. Then it organizes the contents of the original list in rows, with each new row keyed by the values in the new list.
<
This selects rows whose last element is not an empty box.<br>
(In the previous step we created an array of rows of boxes. The short rows were automatically padded with empty boxes so that all rows would be the same length.)
Line 3,364 ⟶ 4,572:
The key to this algorithm is the sorting of the characters in each word from the dictionary. The line <tt>Arrays.sort(chars);</tt> sorts all of the letters in the word in ascending order using a built-in [[quicksort]], so all of the words in the first group in the result end up under the key "aegln" in the anagrams map.
{{works with|Java|1.5+}}
<
import java.io.*;
import java.util.*;
Line 3,370 ⟶ 4,578:
public class WordsOfEqChars {
public static void main(String[] args) throws IOException {
URL url = new URL("http://
InputStreamReader isr = new InputStreamReader(url.openStream());
BufferedReader reader = new BufferedReader(isr);
Line 3,393 ⟶ 4,601:
System.out.println(ana);
}
}</
{{works with|Java|1.8+}}
<
import java.io.*;
import java.util.*;
Line 3,422 ⟶ 4,630:
new InputStreamReader(
new URL(
"http://
).openStream()
)
Line 3,447 ⟶ 4,655:
;
}
}</
{{out}}
[angel, angle, galen, glean, lange]
Line 3,457 ⟶ 4,665:
=={{header|JavaScript}}==
===ES5===
{{Works with|Node.js}}
<
var words = fs.readFileSync('unixdict.txt', 'UTF-8').split('\n');
Line 3,480 ⟶ 4,689:
}
}
}</
{{Out}}
Line 3,490 ⟶ 4,699:
[ 'evil', 'levi', 'live', 'veil', 'vile' ]</pre>
<
var dictionary = fs.readFileSync('unixdict.txt', 'UTF-8').split('\n');
Line 3,512 ⟶ 4,721:
keysSortedByFrequency.slice(0, 10).forEach(function (key) {
console.log(sortedDict[key].join(' '));
});</
===ES6===
Using JavaScript for Automation
(A JavaScriptCore interpreter on macOS with an Automation library).
<syntaxhighlight lang="javascript">(() => {
'use strict';
// largestAnagramGroups :: FilePath -> Either String [[String]]
const largestAnagramGroups = fp =>
either(msg => msg)(strLexicon => {
const
groups = sortBy(flip(comparing(length)))(
groupBy(on(eq)(fst))(
sortBy(comparing(fst))(
strLexicon
.split(/[\r\n]/)
.map(w => [w.split('').sort().join(''), w])
)
)
),
maxSize = groups[0].length;
return map(map(snd))(
takeWhile(x => maxSize === x.length)(
groups
)
)
})(readFileLR(fp));
// ------------------------TEST------------------------
const main = () =>
console.log(JSON.stringify(
largestAnagramGroups('unixdict.txt'),
null, 2
))
// -----------------GENERIC FUNCTIONS------------------
// Left :: a -> Either a b
const Left = x => ({
type: 'Either',
Left: x
});
// Right :: b -> Either a b
const Right = x => ({
type: 'Either',
Right: x
});
// Tuple (,) :: a -> b -> (a, b)
const Tuple = a =>
b => ({
type: 'Tuple',
'0': a,
'1': b,
length: 2
});
// comparing :: (a -> b) -> (a -> a -> Ordering)
const comparing = f =>
x => y => {
const
a = f(x),
b = f(y);
return a < b ? -1 : (a > b ? 1 : 0);
};
// either :: (a -> c) -> (b -> c) -> Either a b -> c
const either = fl =>
fr => e => 'Either' === e.type ? (
undefined !== e.Left ? (
fl(e.Left)
) : fr(e.Right)
) : undefined;
// eq (==) :: Eq a => a -> a -> Bool
const eq = a =>
// True when a and b are equivalent.
b => a === b
// flip :: (a -> b -> c) -> b -> a -> c
const flip = f =>
1 < f.length ? (
(a, b) => f(b, a)
) : (x => y => f(y)(x));
// fst :: (a, b) -> a
const fst = tpl =>
// First member of a pair.
tpl[0];
// groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
const groupBy = fEq => xs =>
// // Typical usage: groupBy(on(eq)(f), xs)
0 < xs.length ? (() => {
const
tpl = xs.slice(1).reduce(
(gw, x) => {
const
gps = gw[0],
wkg = gw[1];
return fEq(wkg[0])(x) ? (
Tuple(gps)(wkg.concat([x]))
) : Tuple(gps.concat([wkg]))([x]);
},
Tuple([])([xs[0]])
);
return tpl[0].concat([tpl[1]])
})() : [];
// length :: [a] -> Int
const length = xs => xs.length
// map :: (a -> b) -> [a] -> [b]
const map = f =>
// The list obtained by applying f
// to each element of xs.
// (The image of xs under f).
xs => xs.map(f);
// on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
const on = f =>
// e.g. sortBy(on(compare,length), xs)
g => a => b => f(g(a))(g(b));
// readFileLR :: FilePath -> Either String IO String
const readFileLR = fp => {
const
e = $(),
ns = $.NSString
.stringWithContentsOfFileEncodingError(
$(fp).stringByStandardizingPath,
$.NSUTF8StringEncoding,
e
);
return ns.isNil() ? (
Left(ObjC.unwrap(e.localizedDescription))
) : Right(ObjC.unwrap(ns));
};
// snd :: (a, b) -> b
const snd = tpl => tpl[1];
// sortBy :: (a -> a -> Ordering) -> [a] -> [a]
const sortBy = f =>
xs => xs.slice()
.sort((a, b) => f(a)(b));
// takeWhile :: (a -> Bool) -> [a] -> [a]
// takeWhile :: (Char -> Bool) -> String -> String
const takeWhile = p =>
xs => {
const lng = xs.length;
return 0 < lng ? xs.slice(
0,
until(i => lng === i || !p(xs[i]))(
i => 1 + i
)(0)
) : [];
};
// until :: (a -> Bool) -> (a -> a) -> a -> a
const until = p => f => x => {
let v = x;
while (!p(v)) v = f(v);
return v;
};
// MAIN ---
return main();
})();</syntaxhighlight>
{{Out}}
<pre>[
[
"abel",
"able",
"bale",
"bela",
"elba"
],
[
"caret",
"carte",
"cater",
"crate",
"trace"
],
[
"angel",
"angle",
"galen",
"glean",
"lange"
],
[
"alger",
"glare",
"lager",
"large",
"regal"
],
[
"elan",
"lane",
"lean",
"lena",
"neal"
],
[
"evil",
"levi",
"live",
"veil",
"vile"
]
]</pre>
=={{header|jq}}==
<
(reduce .[] as $word (
{table: {}, max: 0}; # state
Line 3,526 ⟶ 4,955:
# The task:
split("\n") | anagrams
</syntaxhighlight>
{{Out}}
<syntaxhighlight lang="sh">
$ jq -M -s -c -R -f anagrams.jq unixdict.txt
["abel","able","bale","bela","elba"]
Line 3,536 ⟶ 4,965:
["elan","lane","lean","lena","neal"]
["evil","levi","live","veil","vile"]
</syntaxhighlight>
=={{header|Jsish}}==
From Javascript, nodejs entry.
<
var datafile = 'unixdict.txt';
if (console.args[0] == '-more' && Interp.conf('maxArrayList') > 500000)
Line 3,578 ⟶ 5,007:
evil levi live veil vile
=!EXPECTEND!=
*/</
{{out}}
Line 3,587 ⟶ 5,016:
=={{header|Julia}}==
{{works with|Julia|
<
wordlist = open(readlines, download(url))
Line 3,603 ⟶ 5,032:
end
println.(anagram(wordlist))</
{{out}}
Line 3,614 ⟶ 5,043:
=={{header|K}}==
<
=={{header|Kotlin}}==
{{trans|Java}}
<
import java.io.InputStreamReader
import java.net.URL
import kotlin.math.max
fun main(
val url = URL("http://
val isr = InputStreamReader(url.openStream())
val reader = BufferedReader(isr)
Line 3,633 ⟶ 5,063:
chars.sort()
val key = chars.joinToString("")
if (!anagrams.containsKey(key)) anagrams
anagrams[key]
count =
word = reader.readLine()
}
Line 3,642 ⟶ 5,072:
.filter { it.size == count }
.forEach { println(it) }
}</
{{out}}
Line 3,655 ⟶ 5,085:
=={{header|Lasso}}==
<
anagrams = map,
words = include_url('http://
key,
max = 0,
Line 3,682 ⟶ 5,112:
#findings -> join('<br />\n')
</syntaxhighlight>
{{out}}
<pre>abel, able, bale, bela, elba
Line 3,692 ⟶ 5,122:
=={{header|Liberty BASIC}}==
<
open "unixdict.txt" for input as #1
while not(eof(#1))
Line 3,762 ⟶ 5,192:
sorted$=sorted$+chrSort$(chr)
next
end function</
=={{header|LiveCode}}==
LiveCode could definitely use a sort characters command. As it is this code converts the letters into items and then sorts that. I wrote a merge sort for characters, but the conversion to items, built-in-sort, conversion back to string is about 10% faster, and certainly easier to write.
<
put mostCommonAnagrams(url "http://
end mouseUp
Line 3,805 ⟶ 5,235:
replace comma with empty in X
return X
end itemsToChars</
{{out}}
<pre>abel,able,bale,bela,elba
Line 3,816 ⟶ 5,246:
=={{header|Lua}}==
Lua's core library is very small and does not include built-in network functionality. If a networking library were imported, the local file in the following script could be replaced with the remote dictionary file.
<
local bytes = {word:byte(1, -1)}
table.sort(bytes)
return string.char(table.unpack(bytes))
end
Line 3,839 ⟶ 5,269:
print('') -- Finish with a newline.
end
end</
{{out}}
<pre>abel able bale bela elba
Line 3,849 ⟶ 5,279:
=={{header|M4}}==
<
changequote(`[',`]')
define([for],
Line 3,894 ⟶ 5,324:
_max
for([x],1,_n,[ifelse(_get([count],x),_max,[_get([list],x)
])])</
Memory limitations keep this program from working on the full-sized dictionary.
Line 3,912 ⟶ 5,342:
The convert call discards the hashes, which have done their job, and leaves us with a list L of anagram sets.
Finally, we just note the size of the largest sets of anagrams, and pick those off.
<syntaxhighlight lang="maple">
words := HTTP:-Get( "http://
use StringTools, ListTools in
T := Classify( Sort, map( Trim, Split( words ) ) )
Line 3,920 ⟶ 5,350:
m := max( map( nops, L ) ); # what is the largest set?
A := select( s -> evalb( nops( s ) = m ), L ); # get the maximal sets of anagrams
</syntaxhighlight>
The result of running this code is
<syntaxhighlight lang="maple">
A := [{"abel", "able", "bale", "bela", "elba"}, {"angel", "angle", "galen",
"glean", "lange"}, {"alger", "glare", "lager", "large", "regal"}, {"evil",
"levi", "live", "veil", "vile"}, {"caret", "carte", "cater", "crate", "trace"}
, {"elan", "lane", "lean", "lena", "neal"}];
</syntaxhighlight>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Download the dictionary, split the lines, split the word in characters and sort them. Now sort by those words, and find sequences of equal 'letter-hashes'. Return the longest sequences:
<
text={#,StringJoin@@Sort[Characters[#]]}&/@list;
text=SortBy[text,#[[2]]&];
splits=Split[text,#1[[2]]==#2[[2]]&][[All,All,1]];
maxlen=Max[Length/@splits];
Select[splits,Length[#]==maxlen&]</
gives back:
<
An alternative is faster, but requires version 7 (for <code>Gather</code>):
<
maxlen = Max[Length /@ splits];
Select[splits, Length[#] == maxlen &]</
Or using build-in functions for sorting and gathering elements in lists it can be implimented as:
<
anagramGroups[[-1]]</
Also, Mathematica's own word list is available; replacing the list definition with <code>list = WordData[];</code> and forcing <code>maxlen</code> to 5 yields instead this result:
Line 3,968 ⟶ 5,398:
Also if using Mathematica 10 it gets really concise:
<
MaximalBy[GatherBy[list, Sort@*Characters], Length]</
=={{header|Maxima}}==
<
while stringp(s: readline(file)) do L: cons(s, L), close(file), L)$
Line 4,010 ⟶ 5,440:
["angel", "angle", "galen", "glean", "lange"],
["caret", "carte", "cater", "crate", "trace"],
["abel", "able", "bale", "bela", "elba"]] */</
=={{header|MiniScript}}==
This implementation is for use with the [http://miniscript.org/MiniMicro Mini Micro] version of MiniScript. The command-line version does not include a HTTP library. The script can be modified to use the file class to read a local copy of the word list.
<syntaxhighlight lang="miniscript">
wordList = http.get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt").split(char(10))
makeKey = function(word)
return word.split("").sort.join("")
end function
wordSets = {}
for word in wordList
k = makeKey(word)
if not wordSets.hasIndex(k) then
wordSets[k] = [word]
else
wordSets[k].push(word)
end if
end for
counts = []
for wordSet in wordSets.values
counts.push([wordSet.len, wordSet])
end for
counts.sort(0, false)
maxCount = counts[0][0]
for count in counts
if count[0] == maxCount then print count[1]
end for
</syntaxhighlight>
{{out}}
<pre>
["abel", "able", "bale", "bela", "elba"]
["alger", "glare", "lager", "large", "regal"]
["angel", "angle", "galen", "glean", "lange"]
["caret", "carte", "cater", "crate", "trace"]
["elan", "lane", "lean", "lena", "neal"]
["evil", "levi", "live", "veil", "vile"]</pre>
=={{header|MUMPS}}==
<
Set file="unixdict.txt"
Open file:"r" Use file
Line 4,047 ⟶ 5,518:
Quit
Do Anagrams</
<pre>
The anagrams with the most variations:
Line 4,063 ⟶ 5,534:
===Java–Like===
{{trans|Java}}
<
options replace format comments java crossref symbols nobinary
Line 4,073 ⟶ 5,544:
isr = Reader
if localFile = '' then do
durl = URL("http://
dictFrom = durl.toString()
isr = InputStreamReader(durl.openStream())
Line 4,123 ⟶ 5,594:
return
</syntaxhighlight>
{{out}}
<pre>
Searching http://
[abel, able, bale, bela, elba]
[elan, lane, lean, lena, neal]
Line 4,137 ⟶ 5,608:
===Rexx–Like===
Implemented with more NetRexx idioms such as indexed strings, <tt>PARSE</tt> and the NetRexx "built–in functions".
<
options replace format comments java crossref symbols nobinary
Line 4,148 ⟶ 5,619:
isr = Reader
if localFile = '' then do
durl = URL("http://
dictFrom = durl.toString()
isr = InputStreamReader(durl.openStream())
Line 4,194 ⟶ 5,665:
Return
</syntaxhighlight>
{{out}}
<pre>
Searching http://
abel able bale bela elba
elan lane lean lena neal
Line 4,204 ⟶ 5,675:
alger glare lager large regal
caret carte cater crate trace
</pre>
=={{header|NewLisp}}==
<syntaxhighlight lang="newlisp">
;;; Get the words as a list, splitting at newline
(setq data
(parse (get-url "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
"\n"))
;
;;; Replace each word with a list of its key (list of sorted chars) and itself
;;; For example "hello" –> (("e" "h" "l" "l" "o") "hello")
(setq data (map (fn(x) (list (sort (explode x)) x)) data))
;
;;; Sort on the keys (data is modified); (x 0) is the same as (first x)
(sort data (fn(x y) (> (x 0)(y 0))))
;
;;; Return a list of lists of words with the same key
;;; An empty list at the head is inconsequential
(define (group-by-key)
(let (temp '() res '() oldkey '())
(dolist (x data)
(if (= (x 0) oldkey)
(push (x 1) temp)
(begin
(push temp res)
(setq temp (list (x 1)) oldkey (x 0)))))
(push temp res)
res))
;
;;; Print out only groups of more than 4 words
(map println (filter (fn(x) (> (length x) 4)) (group-by-key)))
</syntaxhighlight>
{{out}}
<pre>
("abel" "able" "bale" "bela" "elba")
("caret" "carte" "cater" "crate" "trace")
("angel" "angle" "galen" "glean" "lange")
("alger" "glare" "lager" "large" "regal")
("elan" "lane" "lean" "lena" "neal")
("evil" "levi" "live" "veil" "vile")
</pre>
=={{header|Nim}}==
<
import tables, strutils, algorithm
Line 4,226 ⟶ 5,737:
main()
</syntaxhighlight>
{{out}}
<pre>
Line 4,239 ⟶ 5,750:
=={{header|Oberon-2}}==
Oxford Oberon-2
<
MODULE Anagrams;
IMPORT Files,Out,In,Strings;
Line 4,396 ⟶ 5,907:
DoProcess("unixdict.txt");
END Anagrams.
</syntaxhighlight>
{{out}}
<pre>
Line 4,408 ⟶ 5,919:
=={{header|Objeck}}==
<
use Collection;
class Anagrams {
function : Main(args : String[]) ~ Nil {
lines := HttpClient->New()->Get("http://
anagrams := StringMap->New();
count := 0;
Line 4,448 ⟶ 5,959:
}
}
</syntaxhighlight>
{{out}}
<pre>[abel,able,bale,bela,elba]
Line 4,458 ⟶ 5,969:
=={{header|OCaml}}==
<
let l = ref [] in
let n = String.length str in
Line 4,490 ⟶ 6,001:
( List.iter (Printf.printf " %s") lw;
print_newline () )
) h</
=={{header|Oforth}}==
<
import: collect
import: quicksort
Line 4,504 ⟶ 6,015:
filter( #[ second size m == ] )
apply ( #[ second .cr ] )
;</
{{out}}
Line 4,520 ⟶ 6,031:
Two versions of this, using different collection classes.
===Version 1: Directory of arrays===
<syntaxhighlight lang="oorexx">
-- This assumes you've already downloaded the following file and placed it
-- in the current directory: http://
-- There are several different ways of reading the file. I chose the
Line 4,556 ⟶ 6,067:
say letters":" list~makestring("l", ", ")
end
</syntaxhighlight>
===Version 2: Using the relation class===
This version appears to be the fastest.
<syntaxhighlight lang="oorexx">
-- This assumes you've already downloaded the following file and placed it
-- in the current directory: http://
-- There are several different ways of reading the file. I chose the
Line 4,606 ⟶ 6,117:
say letters":" words~makestring("l", ", ")
end
</syntaxhighlight>
Timings taken on my laptop:
<pre>
Line 4,632 ⟶ 6,143:
=={{header|Oz}}==
<
%% Helper function
fun {ReadLines Filename}
Line 4,660 ⟶ 6,171:
%% Display result (make sure strings are shown as string, not as number lists)
{Inspector.object configureEntry(widgetShowStrings true)}
{Inspect LargestSets}</
=={{header|Pascal}}==
<
// assumes a local file
Line 4,750 ⟶ 6,261:
AnagramList[i].Destroy;
end.</
{{out}}
<pre>
Line 4,761 ⟶ 6,272:
"eilv": evil, levi, live, veil, vile
</pre>
=={{header|PascalABC.NET}}==
<syntaxhighlight lang="delphi">
begin
var s := System.Net.WebClient.Create.DownloadString('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt');
var words := s.Split;
var groups := words.GroupBy(word -> word.Order.JoinToString);
var maxCount := groups.Max(gr -> gr.Count);
groups.Where(gr -> gr.Count = maxCount).PrintLines;
end.
</syntaxhighlight>
{{out}}
<pre>
[abel,able,bale,bela,elba]
[alger,glare,lager,large,regal]
[angel,angle,galen,glean,lange]
[caret,carte,cater,crate,trace]
[elan,lane,lean,lena,neal]
[evil,levi,live,veil,vile]
</pre>
=={{header|Perl}}==
<
my @words = split "\n", do { local(
my %anagram;
push @{ $anagram{join
}
my $count = max(map {scalar @$_} values %anagram);
print "@$ana\n" if
}</syntaxhighlight>
If we calculate <code>$max</code>, then we don't need the CPAN module:
<syntaxhighlight lang="perl">push @{$anagram{ join '' => sort split '' }}, $_ for @words;
$max > @$_ or $max = @$_ for values %anagram;
@$_
{{out}}
alger glare lager large regal
Line 4,793 ⟶ 6,318:
elan lane lean lena neal
caret carte cater crate trace
=={{header|Phix}}==
copied from Euphoria and cleaned up slightly
<!--<syntaxhighlight lang="phix">-->
<span style="color: #004080;">integer</span> <span style="color: #000000;">fn</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">open</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"demo/unixdict.txt"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"r"</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span> <span style="color: #000000;">anagrams</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span> <span style="color: #000000;">last</span><span style="color: #0000FF;">=</span><span style="color: #008000;">""</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">letters</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">word</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">maxlen</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">word</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">trim</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">gets</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fn</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">letters</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">letters</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">word</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">close</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fn</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">letters</span><span style="color: #0000FF;">,</span><span style="color: #000000;">word</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">letters</span><span style="color: #0000FF;">=</span><span style="color: #000000;">last</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">anagrams</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">[$],</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">[$])></span><span style="color: #000000;">maxlen</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">maxlen</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">[$])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color:
<span style="color: #000000;">last</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">letters</span>
<span style="color: #000000;">anagrams</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">word</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\nMost anagrams:\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">anagrams</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">last</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">anagrams</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">last</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">maxlen</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">last</span><span style="color: #0000FF;">,</span><span style="color: #008000;">", "</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 4,875 ⟶ 6,369:
evil, levi, live, veil, vile
</pre>
=={{header|Phixmonti}}==
<syntaxhighlight lang="phixmonti">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
"" var prev
( ) var prov
( ) var res
0 var maxlen
len for
get 1 get dup prev != if
res prov len maxlen > if len var maxlen endif
0 put var res ( ) var prov
endif
var prev
2 get nip
prov swap 0 put var prov
endfor
res
len for
get len maxlen == if ? else drop endif
endfor</syntaxhighlight>
Other solution
<syntaxhighlight lang="phixmonti">include ..\Utilitys.pmt
( )
newd var dict
0 var maxlen
"unixdict.txt" "r" fopen var f
true while
f fgets
dup -1 == if
drop
f fclose
false
else
-1 del
0 put
true
endif
endwhile
len for
get dup >ps sort dup >ps
dict swap getd dup
"Unfound" == if
drop ps> ps> 1 tolist
else
ps> swap ps> 0 put len maxlen max var maxlen
endif
2 tolist setd var dict
endfor
drop dict 2 get nip
len for
get len maxlen == if ? else drop endif
endfor</syntaxhighlight>
{{out}}<pre>["abel", "able", "bale", "bela", "elba"]
["caret", "carte", "cater", "crate", "trace"]
["angel", "angle", "galen", "glean", "lange"]
["alger", "glare", "lager", "large", "regal"]
["elan", "lane", "lean", "lena", "neal"]
["evil", "levi", "live", "veil", "vile"]
=== Press any key to exit ===</pre>
=={{header|PHP}}==
<
$words = explode("\n", file_get_contents('http://
foreach ($words as $word) {
$chars = str_split($word);
Line 4,889 ⟶ 6,474:
if (count($ana) == $best)
print_r($ana);
?></
=={{header|Picat}}==
Using foreach loop:
<syntaxhighlight lang="picat">go =>
Dict = new_map(),
foreach(Line in read_file_lines("unixdict.txt"))
Sorted = Line.sort(),
Dict.put(Sorted, Dict.get(Sorted,"") ++ [Line] )
end,
MaxLen = max([Value.length : _Key=Value in Dict]),
println(maxLen=MaxLen),
foreach(_Key=Value in Dict, Value.length == MaxLen)
println(Value)
end,
nl.</syntaxhighlight>
{{out}}
<pre>maxLen = 5
[alger,glare,lager,large,regal]
[evil,levi,live,veil,vile]
[abel,able,bale,bela,elba]
[caret,carte,cater,crate,trace]
[angel,angle,galen,glean,lange]
[elan,lane,lean,lena,neal]</pre>
Same idea, but shorter version by (mis)using list comprehensions.
<syntaxhighlight lang="picat">go2 =>
M = new_map(),
_ = [_:W in read_file_lines("unixdict.txt"),S=sort(W),M.put(S,M.get(S,"")++[W])],
X = max([V.len : _K=V in M]),
println(maxLen=X),
[V : _=V in M, V.len=X].println.</syntaxhighlight>
{{out}}
<pre>maxLen = 5
[[evil,levi,live,veil,vile],[abel,able,bale,bela,elba],[caret,carte,cater,crate,trace],[angel,angle,galen,glean,lange],[elan,lane,lean,lena,neal],[alger,glare,lager,large,regal]]</pre>
=={{header|PicoLisp}}==
A straight-forward implementation using 'group' takes 48 seconds on a 1.7 GHz Pentium:
<
(by length sort
(by '((L) (sort (copy L))) group
(in "unixdict.txt" (make (while (line) (link @)))) ) ) )</
Using a binary tree with the 'idx' function, it takes only 0.42 seconds on the same machine, a factor of 100 faster:
<
(in "unixdict.txt"
(while (line)
Line 4,905 ⟶ 6,526:
(push (car @) Word)
(set Key (list Word)) ) ) ) )
(flip (by length sort (mapcar val (idx 'Words)))) )</
{{out}}
<pre>-> (("vile" "veil" "live" "levi" "evil") ("trace" "crate" "cater" "carte" "caret
Line 4,913 ⟶ 6,534:
=={{header|PL/I}}==
<
word_test: proc options (main);
Line 4,979 ⟶ 6,600:
end is_anagram;
end word_test;</
{{out}}
<pre>
Line 4,986 ⟶ 6,607:
abel alger angel caret elan evil
</pre>
=={{header|Pointless}}==
<syntaxhighlight lang="pointless">output =
readFileLines("unixdict.txt")
|> reduce(logWord, {})
|> vals
|> getMax
|> printLines
logWord(dict, word) =
(dict with $[chars] = [word] ++ getDefault(dict, [], chars))
where chars = sort(word)
getMax(groups) =
groups |> filter(g => length(g) == maxLength)
where maxLength = groups |> map(length) |> maximum</syntaxhighlight>
{{out}}
<pre>["elba", "bela", "bale", "able", "abel"]
["neal", "lena", "lean", "lane", "elan"]
["vile", "veil", "live", "levi", "evil"]
["lange", "glean", "galen", "angle", "angel"]
["regal", "large", "lager", "glare", "alger"]
["trace", "crate", "cater", "carte", "caret"]</pre>
=={{header|PowerShell}}==
{{works with|PowerShell|2}}
<
$words = -split ($c.DownloadString('http://
$top_anagrams = $words `
| ForEach-Object {
Line 5,001 ⟶ 6,646:
| Select-Object -First 1
$top_anagrams.Group | ForEach-Object { $_.Group -join ', ' }</
{{out}}
<pre>abel, able, bale, bela, elba
Line 5,009 ⟶ 6,654:
elan, lane, lean, lena, neal
evil, levi, live, veil, vile</pre>
Another way with more .Net methods is quite a different style, but drops the runtime from 2 minutes to 1.5 seconds:
<syntaxhighlight lang="powershell">$Timer = [System.Diagnostics.Stopwatch]::StartNew()
$uri = 'http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'
$words = -split [Net.WebClient]::new().DownloadString($uri)
$anagrams = @{}
$maxAnagramCount = 0
foreach ($w in $words)
{
# Sort the characters in the word into alphabetical order
$chars=[char[]]$w
[array]::sort($chars)
$orderedChars = [string]::Join('', $chars)
# If no anagrams list for these chars, make one
if (-not $anagrams.ContainsKey($orderedChars))
{
$anagrams[$orderedChars] = [Collections.Generic.List[String]]::new()
}
# Add current word as an anagram of these chars,
# in a way which keeps the list available
($list = $anagrams[$orderedChars]).Add($w)
# Keep running score of max number of anagrams seen
if ($list.Count -gt $maxAnagramCount)
{
$maxAnagramCount = $list.Count
}
}
foreach ($entry in $anagrams.GetEnumerator())
{
if ($entry.Value.Count -eq $maxAnagramCount)
{
[string]::join('', $entry.Value)
}
}</syntaxhighlight>
=={{header|Processing}}==
<syntaxhighlight lang="processing">import java.util.Map;
void setup() {
String[] words = loadStrings("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt");
topAnagrams(words);
}
void topAnagrams (String[] words){
HashMap<String, StringList> anagrams = new HashMap<String, StringList>();
int maxcount = 0;
for (String word : words) {
char[] chars = word.toCharArray();
chars = sort(chars);
String key = new String(chars);
if (!anagrams.containsKey(key)) {
anagrams.put(key, new StringList());
}
anagrams.get(key).append(word);
maxcount = max(maxcount, anagrams.get(key).size());
}
for (StringList ana : anagrams.values()) {
if (ana.size() >= maxcount) {
println(ana);
}
}
}</syntaxhighlight>
{{out}}
<pre>StringList size=5 [ "evil", "levi", "live", "veil", "vile" ]
StringList size=5 [ "abel", "able", "bale", "bela", "elba" ]
StringList size=5 [ "elan", "lane", "lean", "lena", "neal" ]
StringList size=5 [ "angel", "angle", "galen", "glean", "lange" ]
StringList size=5 [ "alger", "glare", "lager", "large", "regal" ]
StringList size=5 [ "caret", "carte", "cater", "crate", "trace" ]</pre>
=={{header|Prolog}}==
{{works with|SWI-Prolog|5.10.0}}
<
anagrams:-
% we read the URL of the words
http_open('http://
read_file(In, [], Out),
close(In),
Line 5,060 ⟶ 6,785:
length(V1, L1),
length(V2, L2),
( L1 < L2 -> R = >; L1 > L2 -> R = <; compare(R, K1, K2)).</
The result is
<pre>[abel,able,bale,bela,elba]
Line 5,072 ⟶ 6,797:
=={{header|PureBasic}}==
{{works with|PureBasic|4.4}}
<
OpenConsole()
Line 5,113 ⟶ 6,838:
NewMap anaMap.ana()
If ReceiveHTTPFile("http://
If ReadFile(1, filename$)
Repeat
Line 5,147 ⟶ 6,872:
PrintN("Press any key"): Repeat: Until Inkey() <> ""
EndIf
EndIf</
{{out}}
<pre>evil, levi, live, veil, vile
Line 5,159 ⟶ 6,884:
===Python 3.X Using defaultdict===
Python 3.2 shell input (IDLE)
<
>>> from collections import defaultdict
>>> words = urllib.request.urlopen('http://
>>> anagram = defaultdict(list) # map sorted chars to anagrams
>>> for word in words:
Line 5,170 ⟶ 6,895:
>>> for ana in anagram.values():
if len(ana) >= count:
print ([x.decode() for x in ana])</
===Python 2.7 version===
Python 2.7 shell input (IDLE)
<
>>> from collections import defaultdict
>>> words = urllib.urlopen('http://
>>> len(words)
25104
Line 5,198 ⟶ 6,923:
>>> count
5
>>></
===Python: Using groupby===
{{trans|Haskell}}
{{works with|Python|2.6}} sort and then group using groupby()
<
>>> words = urllib.urlopen('http://
>>> len(words)
25104
Line 5,224 ⟶ 6,949:
>>> count
5
>>></
Or, disaggregating, speeding up a bit by avoiding the slightly expensive use of ''sorted'' as a key, updating for Python 3, and using a local ''unixdict.txt'':
{{Works with|Python|3.7}}
<syntaxhighlight lang="python">'''Largest anagram groups found in list of words.'''
from os.path import expanduser
from itertools import groupby
from operator import eq
# main :: IO ()
def main():
'''Largest anagram groups in local unixdict.txt'''
print(unlines(
largestAnagramGroups(
lines(readFile('unixdict.txt'))
)
))
# largestAnagramGroups :: [String] -> [[String]]
def largestAnagramGroups(ws):
'''A list of the anagram groups of
of the largest size found in a
given list of words.
'''
# wordChars :: String -> (String, String)
def wordChars(w):
'''A word paired with its
AZ sorted characters
'''
return (''.join(sorted(w)), w)
groups = list(map(
compose(list)(snd),
groupby(
sorted(
map(wordChars, ws),
key=fst
),
key=fst
)
))
intMax = max(map(len, groups))
return list(map(
compose(unwords)(curry(map)(snd)),
filter(compose(curry(eq)(intMax))(len), groups)
))
# GENERIC -------------------------------------------------
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
'''Right to left function composition.'''
return lambda f: lambda x: g(f(x))
# curry :: ((a, b) -> c) -> a -> b -> c
def curry(f):
'''A curried function derived
from an uncurried function.'''
return lambda a: lambda b: f(a, b)
# fst :: (a, b) -> a
def fst(tpl):
'''First member of a pair.'''
return tpl[0]
# lines :: String -> [String]
def lines(s):
'''A list of strings,
(containing no newline characters)
derived from a single new-line delimited string.'''
return s.splitlines()
# from os.path import expanduser
# readFile :: FilePath -> IO String
def readFile(fp):
'''The contents of any file at the path
derived by expanding any ~ in fp.'''
with open(expanduser(fp), 'r', encoding='utf-8') as f:
return f.read()
# snd :: (a, b) -> b
def snd(tpl):
'''Second member of a pair.'''
return tpl[1]
# unlines :: [String] -> String
def unlines(xs):
'''A single string derived by the intercalation
of a list of strings with the newline character.'''
return '\n'.join(xs)
# unwords :: [String] -> String
def unwords(xs):
'''A space-separated string derived from
a list of words.'''
return ' '.join(xs)
# MAIN ---
if __name__ == '__main__':
main()</syntaxhighlight>
{{Out}}
<pre>caret carte cater crate creat creta react recta trace
angor argon goran grano groan nagor orang organ rogan
ester estre reest reset steer stere stree terse tsere</pre>
=={{header|QB64}}==
<syntaxhighlight lang="qb64">
$CHECKING:OFF
' Warning: Keep the above line commented out until you know your newly edited code works.
Line 5,290 ⟶ 7,134:
'get the file data loaded in one pop, disk access is slow!
OPEN "unixdict.txt" FOR BINARY AS #1
' http://
' note: when I downloaded this file line breaks were by chr$(10) only.
' Steve had coded for either chr$(13) + chr$(10) or just chr$(10)
Line 5,377 ⟶ 7,221:
IF i < Finish THEN QSort i, Finish
END SUB
</syntaxhighlight>
'''2nd solution (by Steve McNeill):'''
<syntaxhighlight lang="qb64">
$CHECKING:OFF
SCREEN _NEWIMAGE(640, 480, 32)
Line 5,526 ⟶ 7,370:
LOOP UNTIL gap = 1 AND swapped = 0
END SUB
</syntaxhighlight>
'''Output:'''
<syntaxhighlight lang="qb64">
LOOPER: 7134 executions from start to finish, in one second.
Note, this is including disk access for new data each time.
Line 5,541 ⟶ 7,385:
caret, trace, crate, carte, cater
bale, abel, able, elba, bela
</syntaxhighlight>
=={{header|Quackery}}==
<syntaxhighlight lang="quackery"> $ "rosetta/unixdict.txt" sharefile drop nest$
[] swap witheach
[ dup sort
nested swap nested join
nested join ]
sortwith [ 0 peek swap 0 peek $< ]
dup
[ dup [] ' [ [ ] ] rot
witheach
[ tuck 0 peek swap 0 peek = if
[ tuck nested join swap ] ]
drop
dup [] != while
nip again ]
drop
witheach
[ over witheach
[ 2dup 0 peek swap 0 peek = iff
[ 1 peek echo$ sp ]
else drop ]
drop cr ]
drop</syntaxhighlight>
{{out}}
<pre>abel able bale bela elba
caret carte cater crate trace
angel angle galen glean lange
alger glare lager large regal
elan lane lean lena neal
evil levi live veil vile
</pre>
=={{header|R}}==
<
word_group <- sapply(
strsplit(words, split=""), # this will split all words to single letters...
Line 5,565 ⟶ 7,444:
"angel, angle, galen, glean, lange" "alger, glare, lager, large, regal"
aeln eilv
"elan, lane, lean, lena, neal" "evil, levi, live, veil, vile" </
=={{header|Racket}}==
<
#lang racket
Line 5,589 ⟶ 7,468:
(map (λ (k) (hash-ref h k)) max-keys))
(get-maxes (hash-words (get-lines "http://
</syntaxhighlight>
{{out}}
<pre>
Line 5,601 ⟶ 7,480:
</pre>
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2016.08}}
<syntaxhighlight lang="raku" line>my @anagrams = 'unixdict.txt'.IO.words.classify(*.comb.sort.join).values;
my $max = @anagrams».elems.max;
.put for @anagrams.grep(*.elems == $max);</syntaxhighlight>
{{out}}
caret carte cater crate trace
angel angle galen glean lange
alger glare lager large regal
elan lane lean lena neal
evil levi live veil vile
abel able bale bela elba
Just for the fun of it, here's a one-liner that uses no temporaries. Since it would be rather long, we've oriented it vertically:
{{works with|Rakudo|2016.08}}
<syntaxhighlight lang="raku" line>.put for # print each element of the array made this way:
'unixdict.txt'.IO.words # load words from file
.classify(*.comb.sort.join) # group by common anagram
.classify(*.value.elems) # group by number of anagrams in a group
.max(*.key).value # get the group with highest number of anagrams
.map(*.value) # get all groups of anagrams in the group just selected</syntaxhighlight>
=={{header|RapidQ}}==
<syntaxhighlight lang="vb">
dim x as integer, y as integer
dim SortX as integer
Line 5,668 ⟶ 7,574:
End
</syntaxhighlight>
{{out}}
<pre>
Line 5,680 ⟶ 7,586:
=={{header|Rascal}}==
<
list[str] OrderedRep(str word){
Line 5,686 ⟶ 7,592:
}
public list[set[str]] anagram(){
allwords = readFileLines(|http://
AnagramMap = invert((word : OrderedRep(word) | word <- allwords));
longest = max([size(group) | group <- range(AnagramMap)]);
return [AnagramMap[rep]| rep <- AnagramMap, size(AnagramMap[rep]) == longest];
}</
Returns:
<
{"glean","galen","lange","angle","angel"},
{"glare","lager","regal","large","alger"},
Line 5,699 ⟶ 7,605:
{"able","bale","abel","bela","elba"},
{"levi","live","vile","evil","veil"}
]</
=={{header|Red}}==
<
m: make map! [] 25000
maxx: 0
foreach word read/lines http://
sword: sort copy word ;; sorted characters of word
Line 5,717 ⟶ 7,624:
]
foreach v values-of m [ if maxx = length? v [print v] ]
</syntaxhighlight>
{{out}}
<pre>abel able bale bela elba
Line 5,732 ⟶ 7,639:
This version doesn't assume that the dictionary is in alphabetical order, nor does it assume the
<br>words are in any specific case (lower/upper/mixed).
<
iFID= 'unixdict.txt' /*the dictionary input File IDentifier.*/
$=; !.=; ww=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/
Line 5,761 ⟶ 7,668:
/*reassemble word with sorted letters. */
return @.a || @.b || @.c || @.d || @.e || @.f||@.g||@.h||@.i||@.j||@.k||@.l||@.m||,
@.n || @.o || @.p || @.q || @.r || @.s||@.t||@.u||@.v||@.w||@.x||@.y||@.z</
Programming note: the long (wide) assignment for '''return @.a||'''... could've been coded as an elegant '''do''' loop instead of hardcoding 26 letters,<br>but since the dictionary (word list) is rather large, a rather expaciated method was used for speed.
Line 5,780 ⟶ 7,687:
===version 1.2, optimized===
This optimized version eliminates the '''sortA''' subroutine and puts that subroutine's code in-line.
<
iFID= 'unixdict.txt' /*the dictionary input File IDentifier.*/
$=; !.=; ww=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/
Line 5,809 ⟶ 7,716:
/*reassemble word with sorted letters. */
return @.a || @.b || @.c || @.d || @.e || @.f||@.g||@.h||@.i||@.j||@.k||@.l||@.m||,
@.n || @.o || @.p || @.q || @.r || @.s||@.t||@.u||@.v||@.w||@.x||@.y||@.z</
{{out|output|text= is the same as REXX version 1.1}}
Line 5,817 ⟶ 7,724:
===annotated version using PARSE===
(This algorithm actually utilizes a ''bin'' sort, one bin for each Latin letter.)
<
upper u /*fast method to uppercase a variable. */
/*another: u = translate(u) */
Line 5,839 ⟶ 7,746:
/*Note: the ? is prefixed to the letter to avoid */
/*collisions with other REXX one-character variables.*/
say 'z=' z</
{{out|output|:}}
<pre>
Line 5,847 ⟶ 7,754:
===annotated version using a DO loop===
<
upper u /*fast method to uppercase a variable. */
L=length(u) /*get the length of the word (in bytes)*/
Line 5,864 ⟶ 7,771:
_.?n||_.?o||_.?p||_.?q||_.?r||_.?s||_.?t||_.?u||_.?v||_.?w||_.?x||_.?y||_.?z
say 'z=' z</
{{out|output|:}}
<pre>
Line 5,873 ⟶ 7,780:
===version 2===
<
* 07.08.2013 Walter Pachl
* sorta for word compression courtesy Gerard Schildberger,
Line 5,933 ⟶ 7,840:
End
Return c.a||c.b||c.c||c.d||c.e||c.f||c.g||c.h||c.i||c.j||c.k||c.l||,
c.m||c.n||c.o||c.p||c.q||c.r||c.s||c.t||c.u||c.v||c.w||c.x||c.y||c.z</
{{out}}
<pre>
Line 5,951 ⟶ 7,858:
=={{header|Ring}}==
<
# Project : Anagrams
Line 6,032 ⟶ 7,939:
end
return cnt
</syntaxhighlight>
Output:
<pre>
Line 6,055 ⟶ 7,962:
=={{header|Ruby}}==
<
anagram = Hash.new {|hash, key| hash[key] = []} # map sorted chars to anagrams
URI.open('http://
words = f.read.split
for word in words
Line 6,071 ⟶ 7,978:
p ana
end
end</
{{out}}
<pre>
Line 6,083 ⟶ 7,990:
Short version (with lexical ordered result).
<
anagrams = open('http://
anagrams.values.group_by(&:size).max.last.each{|group| puts group.join(", ") }
</syntaxhighlight>
{{Out}}
<pre>
Line 6,097 ⟶ 8,004:
evil, levi, live, veil, vile
</pre>
=={{header|Run BASIC}}==
<
mem$ = "CREATE TABLE anti(gram,ordr);
CREATE INDEX ord ON anti(ordr)"
#mem execute(mem$)
' read the file
a$ = httpGet$("http://
' break the file words apart
Line 6,161 ⟶ 8,069:
print
next i
end</
<pre>
abel able bale bela elba
Line 6,174 ⟶ 8,082:
Unicode is hard so the solution depends on what you consider to be an anagram: two strings that have the same bytes, the same codepoints, or the same graphemes. The first two are easily accomplished in Rust proper, but the latter requires an external library. Graphemes are probably the most correct way, but it is also the least efficient since graphemes are variable size and thus require a heap allocation per grapheme.
<
use std::fs::File;
use std::io::{BufRead,BufReader};
Line 6,203 ⟶ 8,111:
}
}
}</
{{out}}
<pre>
Line 6,216 ⟶ 8,124:
If we assume an ASCII string, we can map each character to a prime number and multiply these together to create a number which uniquely maps to each anagram.
<
use std::path::Path;
use std::io::{self, BufRead, BufReader};
Line 6,257 ⟶ 8,165:
}
Ok(map.into_iter().map(|(_, entry)| entry).collect())
}</
=={{header|Scala}}==
<
val vls = src.getLines.toList.groupBy(_.sorted).values
val max = vls.map(_.size).max
vls filter (_.size == max) map (_ mkString " ") mkString "\n"</
{{out}}
<pre>
Line 6,275 ⟶ 8,183:
----
Another take:
<
.fromURL("http://
.groupBy(_.sorted).values
.groupBy(_.size).maxBy(_._1)._2
.map(_.mkString("\t"))
.foreach(println)</
{{out}}
<pre>
Line 6,295 ⟶ 8,203:
Uses two SRFI libraries: SRFI 125 for hash tables and SRFI 132 for sorting.
<
(import (scheme base)
(scheme char)
Line 6,337 ⟶ 8,245:
(map (lambda (grp) (list-sort string<? grp))
(largest-groups (read-groups)))))
</syntaxhighlight>
{{out}}
Line 6,350 ⟶ 8,258:
=={{header|Seed7}}==
<
include "gethttp.s7i";
include "strifile.s7i";
Line 6,385 ⟶ 8,293:
var integer: maxLength is 0;
begin
dictFile :=
while hasNext(dictFile) do
readln(dictFile, word);
Line 6,405 ⟶ 8,313:
end if;
end for;
end func;</
{{out}}
Line 6,418 ⟶ 8,326:
=={{header|SETL}}==
<
anagrams := {};
while not eof(h) loop
Line 6,457 ⟶ 8,365:
end loop;
return A;
end procedure;</
{{out}}
<pre>{abel able bale bela elba}
Line 6,465 ⟶ 8,373:
{elan lane lean lena neal}
{evil levi live veil vile}</pre>
=={{header|Sidef}}==
<
file.open_r(\var fh, \var err) ->
|| die "Can't open file `#{file}' for reading: #{err}\n";
Line 6,477 ⟶ 8,384:
}
main(%f'/tmp/unixdict.txt');</
{{out}}
<pre>alger glare lager large regal
Line 6,485 ⟶ 8,392:
evil levi live veil vile
caret carte cater crate trace</pre>
=={{header|Simula}}==
<
$ cim -m64 anagrams-hashmap.sim
;
Line 6,755 ⟶ 8,663:
END
</syntaxhighlight>
{{out}}
<pre>
Line 6,770 ⟶ 8,678:
=={{header|Smalltalk}}==
<
dict:= Dictionary new.
list do: [:val|
Line 6,776 ⟶ 8,684:
add: val.
].
sorted:=dict asSortedCollection: [:a :b| a size > b size].</
Documentation:
<pre>
Line 6,794 ⟶ 8,702:
{{works with|Smalltalk/X}}
instead of asking for the strings, read the file:
<
'unixdict.txt' asFilename
readingLinesDo:[:eachWord |
Line 6,803 ⟶ 8,711:
sortBySelector:#size)
reverse
do:[:s | s printCR]</
{{out}}
<pre>
Line 6,815 ⟶ 8,723:
...</pre>
not sure if getting the dictionary via http is part of the task; if so, replace the file-reading with:
<
=={{header|SNOBOL4}}==
{{works with|Macro Spitbol}}
Note: unixdict.txt is passed in locally via STDIN. Newlines must be converted for Win/DOS environment.
<
define('sortw(str)a,i,j') :(sortw_end)
sortw a = array(size(str))
Line 6,842 ⟶ 8,750:
L3 j = j + 1; key = kv<j,1>; val = kv<j,2> :f(end)
output = eq(countw(val),max) key ': ' val :(L3)
end</
{{out}}
<pre>abel: abel able bale bela elba
Line 6,852 ⟶ 8,760:
=={{header|Stata}}==
<
mata
a=st_sdata(.,.)
Line 6,867 ⟶ 8,775:
reshape wide v1, i(k) j(group) string
drop k
list, noobs noheader</
'''Output'''
Line 6,880 ⟶ 8,788:
=={{header|SuperCollider}}==
<syntaxhighlight lang="supercollider">(
var text, words, sorted, dict = IdentityDictionary.new, findMax;
File.use("unixdict.txt".resolveRelative, "r", { |f| text = f.readAllString });
Line 6,899 ⟶ 8,807:
};
findMax.(dict)
)</
Answers:
<
=={{header|Swift}}==
{{works with|Swift 2.0}}
<
let wordsURL = NSURL(string: "http://
let wordsstring = try NSString(contentsOfURL:wordsURL , encoding: NSUTF8StringEncoding)
Line 6,948 ⟶ 8,856:
print("set \(i): \(thislist.sort())")
}
</syntaxhighlight>
{{out}}
Line 6,963 ⟶ 8,871:
=={{header|Tcl}}==
<
package require http
set url http://
set response [http::geturl $url]
set data [http::data $response]
Line 6,986 ⟶ 8,894:
puts $anagrams($key)
}
}</
{{out}}
<pre>evil levi live veil vile
Line 6,994 ⟶ 8,902:
angel angle galen glean lange
alger glare lager large regal</pre>
=={{header|Transd}}==
<syntaxhighlight lang="scheme">#lang transd
MainModule: {
_start: (λ
(with fs FileStream() words String()
(open-r fs "/mnt/proj/tmp/unixdict.txt")
(textin fs words)
( -|
(split words)
(group-by (λ s String() -> String() (sort (cp s))))
(regroup-by (λ v Vector<String>() -> Int() (size v)))
(max-element)
(snd)
(textout)
)
))
}</syntaxhighlight>{{out}}
<pre>
[[abel, able, bale, bela, elba],
[caret, carte, cater, crate, trace],
[angel, angle, galen, glean, lange],
[alger, glare, lager, large, regal],
[elan, lane, lean, lena, neal],
[evil, levi, live, veil, vile]]
</pre>
=={{header|TUSCRIPT}}==
<
requestdata = REQUEST ("http://
DICT anagramm CREATE 99999
Line 7,023 ⟶ 8,959:
PRINT cs," ",f,": ",a
ENDLOOP
ENDCOMPILE</
{{out}}
<pre>
Line 7,044 ⟶ 8,980:
Process substitutions eliminate the need for command pipelines.
<
local host=$1
local uri=$2
Line 7,064 ⟶ 9,000:
uniq_letters=( $(for ((i=0; i<${#word}; i++)); do echo "${word:i:1}"; done | sort) )
wordlist["${uniq_letters[*]}"]+="$word "
done < <( http_get_body
maxlen=0
Line 7,079 ⟶ 9,015:
done
printf "%s\n" "${maxwords[@]}"</
{{output}}
Line 7,093 ⟶ 9,029:
The algorithm is to group the words together that are made from the same unordered lists of letters, then collect the groups together that have the same number of words in
them, and then show the collection associated with the highest number.
<
#show+
anagrams = mat` * leql$^&h eql|=@rK2tFlSS ^(~&,-<&)* unixdict_dot_txt</
{{out}}
<pre>
Line 7,106 ⟶ 9,042:
angel angle galen glean lange
abel able bale bela elba</pre>
=={{header|VBA}}==
<syntaxhighlight lang="vb">
Option Explicit
Line 7,353 ⟶ 9,206:
If (mini < j) Then Call SortTwoDimArray(myArr, mini, j, Colonne)
If (i < Maxi) Then Call SortTwoDimArray(myArr, i, Maxi, Colonne)
End Sub</
{{out}}
<pre>25104 words, in the dictionary
Line 7,366 ⟶ 9,219:
Time to go : 2,464844 seconds.</pre>
=={{header|VBScript}}==
A little convoluted, uses a dictionary and a recordset...
<syntaxhighlight lang="vb">
Const adInteger = 3
Const adVarChar = 200
function charcnt(s,ch)
charcnt=0
for i=1 to len(s)
if mid(s,i,1)=ch then charcnt=charcnt+1
next
end function
set fso=createobject("Scripting.Filesystemobject")
dim a(122)
sfn=WScript.ScriptFullName
sfn= Left(sfn, InStrRev(sfn, "\"))
set f=fso.opentextfile(sfn & "unixdict.txt",1)
'words to dictionnary using acronym as key
set d=createobject("Scripting.Dictionary")
while not f.AtEndOfStream
erase a :cnt=0
s=trim(f.readline)
'tally chars
for i=1 to len(s)
n=asc(mid(s,i,1))
a(n)=a(n)+1
next
'build the anagram
k=""
for i= 48 to 122
if a(i) then k=k & string(a(i),chr(i))
next
'add to dict
if d.exists(k) then
b=d(k)
d(k)=b & " " & s
else
d(k)=s
end if
wend
'copy dictionnary to recorset to be able to sort it .Add nr of items as a new field
Set rs = CreateObject("ADODB.Recordset")
rs.Fields.Append "anag", adVarChar, 30
rs.Fields.Append "items", adInteger
rs.Fields.Append "words", adVarChar, 200
rs.open
for each k in d.keys
rs.addnew
rs("anag")=k
s=d(k)
rs("words")=s
rs("items")=charcnt(s," ")+1
rs.update
next
d.removeall
'do the query
rs.sort="items DESC, anag ASC"
rs.movefirst
it=rs("items")
while rs("items")=it
wscript.echo rs("items") & " (" &rs("anag") & ") " & rs("words")
rs.movenext
wend
rs.close
</syntaxhighlight>
The output:
<pre>
5 (abel) abel able bale bela elba
5 (acert) caret carte cater crate trace
5 (aegln) angel angle galen glean lange
5 (aeglr) alger glare lager large regal
5 (aeln) elan lane lean lena neal
5 (eilv) evil levi live veil vile
</pre>
=={{header|Vedit macro language}}==
This implementation first sorts characters of each word using Insertion sort in subroutine SORT_LETTERS.<br>
Then the word list is sorted using built-in Sort function.<br>
Finally, groups of words are analyzed and largest groups are recorded.
The word list is expected to be in the same directory as the script.
<syntaxhighlight lang="vedit">File_Open("|(PATH_ONLY)\unixdict.txt")
Repeat(ALL) {
Reg_Copy_Block(10, CP, EOL_Pos) // original word
Call("SORT_LETTERS") // sort letters of the word
EOL
IC(' ') Reg_Ins(10) // add the original word at eol
Line(1, ERRBREAK)
}
Sort(0, File_Size) // sort list according to anagrams
BOF
Search("|F") Search(' ') // first word in the list
Reg_Copy_Block(10, BOL_Pos, CP+1) // reg 10 = sorted anagram word
Reg_Copy_Block(11, CP, EOL_Pos) // reg 11 = list of words in current group
Reg_Empty(12) // reg 12 = list of words in largest groups
Reg_Set(13, "
")
#1 = 1 // words in this group
#2 = 2 // words in largest group found
Repeat(ALL) {
Line(1, ERRBREAK)
if (Match(@10, ADVANCE) == 0) { // same group as previous word?
Reg_Copy_Block(11, CP-1, EOL_Pos, APPEND) // add word to this group
#1++
} else { // different anagram group
Search(" ", ERRBREAK)
if (#1 == #2) { // same size as the largest?
Reg_Set(12, @13, APPEND) // append newline
Reg_Set(12, @11, APPEND) // append word list
}
if (#1 > #2) { // new larger size of group
Reg_Set(12, @11) // replace word list
#2 = #1
}
Reg_Copy_Block(10, BOL_Pos, CP+1)
Reg_Copy_Block(11, CP, EOL_Pos) // first word of new group
#1 = 1
}
}
Buf_Quit(OK) // close word list file
Buf_Switch(Buf_Free) // output results in a new edit buffer
Reg_Ins(12) // display all groups of longest anagram words
Return
////////////////////////////////////////////////////////////////////
//
// Sort characters in current line using Insertion sort
//
:SORT_LETTERS:
GP(EOL_pos) #9 = Cur_Col-1
for (#1 = 2; #1 <= #9; #1++) {
Goto_Col(#1) #8 = Cur_Char
#2 = #1
while (#2 > 1) {
#7 = Cur_Char(-1)
if (#7 <= #8) { break }
Ins_Char(#7, OVERWRITE)
#2--
Goto_Col(#2)
}
Ins_Char(#8, OVERWRITE)
}
return</syntaxhighlight>
{{out}}
<pre>
abel able bale bela elba
caret carte cater crate trace
angel angle galen glean lange
alger glare lager large regal
elan lane lean lena neal
evil levi live veil vile
</pre>
=={{header|Visual Basic .NET}}==
<
Imports System.Collections.ObjectModel
Line 7,431 ⟶ 9,450:
End Function
End Module</
{{out}}
<PRE>
Line 7,441 ⟶ 9,460:
[EILV] evil, levi, live, veil, vile
</PRE>
=={{header|V (Vlang)}}==
{{trans|Wren}}
<syntaxhighlight lang="v (vlang)">import os
fn main(){
words := os.read_lines('unixdict.txt')?
mut m := map[string][]string{}
mut ma := 0
for word in words {
mut letters := word.split('')
letters.sort()
sorted_word := letters.join('')
if sorted_word in m {
m[sorted_word] << word
} else {
m[sorted_word] = [word]
}
if m[sorted_word].len > ma {
ma = m[sorted_word].len
}
}
for _, a in m {
if a.len == ma {
println(a)
}
}
}</syntaxhighlight>
{{out}}
<pre>
['abel', 'able', 'bale', 'bela', 'elba']
['alger', 'glare', 'lager', 'large', 'regal']
['angel', 'angle', 'galen', 'glean', 'lange']
['caret', 'carte', 'cater', 'crate', 'trace']
['elan', 'lane', 'lean', 'lena', 'neal']
['evil', 'levi', 'live', 'veil', 'vile']
</pre>
=={{header|Wren}}==
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">import "io" for File
import "./sort" for Sort
var words = File.read("unixdict.txt").split("\n").map { |w| w.trim() }
var wordMap = {}
for (word in words) {
var letters = word.toList
Sort.insertion(letters)
var sortedWord = letters.join()
if (wordMap.containsKey(sortedWord)) {
wordMap[sortedWord].add(word)
} else {
wordMap[sortedWord] = [word]
}
}
var most = wordMap.keys.reduce(0) { |max, key| (wordMap[key].count > max) ? wordMap[key].count : max }
for (key in wordMap.keys) {
if (wordMap[key].count == most) System.print(wordMap[key])
}</syntaxhighlight>
{{out}}
<pre>
[abel, able, bale, bela, elba]
[alger, glare, lager, large, regal]
[evil, levi, live, veil, vile]
[angel, angle, galen, glean, lange]
[elan, lane, lean, lena, neal]
[caret, carte, cater, crate, trace]
</pre>
=={{header|Yabasic}}==
<
maxw = 0 : c = 0 : dimens(c)
i = 0
Line 7,523 ⟶ 9,613:
d(j,p) = c
end if
end sub</
=={{header|zkl}}==
<
// blob to dictionary: key is word "fuzzed", values are anagram words
.pump(Void,T(fcn(w,d){
Line 7,538 ⟶ 9,628:
"%d:%s: %s".fmt(v.len(),zz.strip(),
v.apply("strip").concat(","))
});</
{{out}}
<pre>
Line 7,554 ⟶ 9,644:
</pre>
In the case where it is desirable to get the dictionary from the web, use this code:
<
var ZC=Import("zklCurl");
unixdict:=ZC().get(URL); //--> T(Data,bytes of header, bytes of trailer)
unixdict=unixdict[0].del(0,unixdict[1]); // remove HTTP header
File("unixdict.txt","w").write(unixdict);</
{{omit from|6502 Assembly|unixdict.txt is much larger than the CPU's address space.}}
{{omit from|8080 Assembly|See 6502 Assembly.}}
{{omit from|PARI/GP|No real capacity for string manipulation}}
{{omit from|Z80 Assembly|See 6502 Assembly.}}
| |||