aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Anagrams/00-META.yaml Normal file
View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/Anagrams
note: Text processing

14
Task/Anagrams/00-TASK.txt Normal file
View file

@ -0,0 +1,14 @@
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
{{Related tasks/Word plays}}
{{Template:Strings}}
<br><br>

9
Task/Anagrams/11l/anagrams.11l Normal file
View file

@ -0,0 +1,9 @@
DefaultDict[String, Array[String]] anagram
L(word) File(‘unixdict.txt’).read().split("\n")
anagram[sorted(word)].append(word)
V count = max(anagram.values().map(ana -> ana.len))
L(ana) anagram.values()
I ana.len == count
print(ana)

132
Task/Anagrams/8th/anagrams.8th Normal file
View file

@ -0,0 +1,132 @@
\
\ anagrams.8th
\ Rosetta Code - Anagrams problem
\ Using the word list at:
\ http://wiki.puzzlers.org/pub/wordlists/unixdict.txt,
\ find the sets of words that share the same characters
\ that contain the most words in them.
\
ns: anagrams
m:new var, anamap
a:new var, anaptr
0 var, analen
\ sort a string
: s:sort \ s -- s \
null s:/ \ a
' s:cmpi a:sort \ a
"" a:join \ s
;
: process-words \ word -- \ word
s:lc \ word
dup \ word word
>r \ word | word
\ 1. we create a sorted version of the curret word (sword)
s:sort \ sword | word
\ We check if sword can be found in map anamap
anamap @ \ sword anamap | word
over \ sword anamap sword | word
m:exists? \ sword anamap boolean | word
if \ sword anamap | word
\ If sword already exists in anamap:
\ - get mapvalue, which is an array
\ - add the original word to that array
\ - store the array in the map with key sword
over \ sword anamap sword | word
m:@ \ sword anamap array | word
r> \ sword anamap array word
a:push \ sword anamap array
rot \ anamap array sword
swap \ anamap sword array
m:! \ anamap
else \ sword anamap | word
\ If sword does not yet exist in anamap:
\ - create empty array
\ - put the original word into that array
\ - store the array in the map with key sword
swap \ anamap sword | word
a:new \ anamap sword array | word
r> \ anamap sword array word
a:push \ anamap sword array
m:! \ anamap
then
drop \
;
\ Read and check all words in array analist
: read-and-check-words \ -- \
"analist.txt" \ fname
f:open-ro \ f
' process-words f:eachline \ f
f:close \
;
: len< \ key array arraylen -- \ key array arraylen
2drop \ key
drop \
;
: len= \ key array arraylen -- \ key array arraylen
2drop \ key
anaptr @ \ key anaptr
swap \ anaptr key
a:push \ anaptr
drop \
;
: len> \ key array arraylen -- \ key array arraylen
analen \ key array arraylen analen
! \ key array
drop \ key
anaptr @ \ key anaptr
a:clear \ key anaptr
swap \ anaptr key
a:push \ anaptr
drop \
;
: fetch-longest-list \ key array -- \ key array
a:len \ key array arraylen
analen @ \ key array arraylen analen
2dup \ key array arraylen analen arraylen analen
n:cmp \ key array arraylen analen value
1 n:+ \ key array arraylen analen value
nip \ key array arraylen value
[ ' len< , ' len= , ' len> ] \ key array arraylen value swarr
swap \ key array arraylen swarr value
caseof \
;
: list-words-1 \ ix value -- \ ix value
nip \ value
"\t" . . \
;
: list-words \ ix value -- \ ix value
nip \ value
anamap @ \ value anamap
swap \ anamap value
m:@ \ anamap array
nip \ array
' list-words-1 a:each \ array
cr \ array
drop \
;
: app:main
\ Create a map, where the values are arrays, containing all words
\ which are the same when sorted (sword); sword is used as key
read-and-check-words
\ Create an array that holds the keys for anamap, for which the value,
\ which is the array of anagrams, has the biggest length found.
anamap @ ' fetch-longest-list m:each
\ Dump the resulting words to the console
anaptr @ ' list-words a:each drop
bye
;

386
Task/Anagrams/AArch64-Assembly/anagrams.aarch64 Normal file
View file

@ -0,0 +1,386 @@
/* 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"

102
Task/Anagrams/ABAP/anagrams.abap Normal file
View file

@ -0,0 +1,102 @@
report zz_anagrams no standard page heading.
define update_progress.
call function 'SAPGUI_PROGRESS_INDICATOR'
exporting
text = &1.
end-of-definition.
" Selection screen segment allowing the person to choose which file will act as input.
selection-screen begin of block file_choice.
parameters p_file type string lower case.
selection-screen end of block file_choice.
" When the user requests help with input, run the routine to allow them to navigate the presentation server.
at selection-screen on value-request for p_file.
perform getfile using p_file.
at selection-screen output.
%_p_file_%_app_%-text = 'Input File: '.
start-of-selection.
data: gt_data type table of string.
" Read the specified file from the presentation server into memory.
perform readfile using p_file changing gt_data.
" After the file has been read into memory, loop through it line-by-line and make anagrams.
perform anagrams using gt_data.
" Subroutine for generating a list of anagrams.
" The supplied input is a table, with each entry corresponding to a word.
form anagrams using it_data like gt_data.
types begin of ty_map.
types key type string.
types value type string.
types end of ty_map.
data: lv_char type c,
lv_len type i,
lv_string type string,
ls_entry type ty_map,
lt_anagrams type standard table of ty_map,
lt_c_tab type table of string.
field-symbols: <fs_raw> type string.
" Loop through each word in the table, and make an associative array.
loop at gt_data assigning <fs_raw>.
" First, we need to re-order the word alphabetically. This generated a key. All anagrams will use this same key.
" Add each character to a table, which we will then sort alphabetically.
lv_len = strlen( <fs_raw> ).
refresh lt_c_tab.
do lv_len times.
lv_len = sy-index - 1.
append <fs_raw>+lv_len(1) to lt_c_tab.
enddo.
sort lt_c_tab as text.
" Now append the characters to a string and add it as a key into the map.
clear lv_string.
loop at lt_c_tab into lv_char.
concatenate lv_char lv_string into lv_string respecting blanks.
endloop.
ls_entry-key = lv_string.
ls_entry-value = <fs_raw>.
append ls_entry to lt_anagrams.
endloop.
" After we're done processing, output a list of the anagrams.
clear lv_string.
loop at lt_anagrams into ls_entry.
" Is it part of the same key --> Output in the same line, else a new entry.
if lv_string = ls_entry-key.
write: ', ', ls_entry-value.
else.
if sy-tabix <> 1.
write: ']'.
endif.
write: / '[', ls_entry-value.
endif.
lv_string = ls_entry-key.
endloop.
" Close last entry.
write ']'.
endform.
" Read a specified file from the presentation server.
form readfile using i_file type string changing it_raw like gt_data.
data: l_datat type string,
l_msg(2048),
l_lines(10).
" Read the file into memory.
update_progress 'Reading file...'.
call method cl_gui_frontend_services=>gui_upload
exporting
filename = i_file
changing
data_tab = it_raw
exceptions
others = 1.
" Output error if the file could not be uploaded.
if sy-subrc <> 0.
write : / 'Error reading the supplied file!'.
return.
endif.
endform.

93
Task/Anagrams/ALGOL-68/anagrams.alg Normal file
View file

@ -0,0 +1,93 @@
# find longest list(s) of words that are anagrams in a list of words #
# use the associative array in the Associate array/iteration task #
PR read "aArray.a68" PR
# returns the number of occurances of ch in text #
PROC count = ( STRING text, CHAR ch )INT:
BEGIN
INT result := 0;
FOR c FROM LWB text TO UPB text DO IF text[ c ] = ch THEN result +:= 1 FI OD;
result
END # count # ;
# returns text with the characters sorted into ascending order #
PROC char sort = ( STRING text )STRING:
BEGIN
STRING sorted := text;
FOR end pos FROM UPB sorted - 1 BY -1 TO LWB sorted
WHILE
BOOL swapped := FALSE;
FOR pos FROM LWB sorted TO end pos DO
IF sorted[ pos ] > sorted[ pos + 1 ]
THEN
CHAR t := sorted[ pos ];
sorted[ pos ] := sorted[ pos + 1 ];
sorted[ pos + 1 ] := t;
swapped := TRUE
FI
OD;
swapped
DO SKIP OD;
sorted
END # char sort # ;
# read the list of words and store in an associative array #
CHAR separator = "|"; # character that will separate the anagrams #
IF FILE input file;
STRING file name = "unixdict.txt";
open( input file, file name, stand in channel ) /= 0
THEN
# failed to open the file #
print( ( "Unable to open """ + file name + """", newline ) )
ELSE
# file opened OK #
BOOL at eof := FALSE;
# set the EOF handler for the file #
on logical file end( input file, ( REF FILE f )BOOL:
BEGIN
# note that we reached EOF on the #
# latest read #
at eof := TRUE;
# return TRUE so processing can continue #
TRUE
END
);
REF AARRAY words := INIT LOC AARRAY;
STRING word;
WHILE NOT at eof
DO
STRING word;
get( input file, ( word, newline ) );
words // char sort( word ) +:= separator + word
OD;
# close the file #
close( input file );
# find the maximum number of anagrams #
INT max anagrams := 0;
REF AAELEMENT e := FIRST words;
WHILE e ISNT nil element DO
IF INT anagrams := count( value OF e, separator );
anagrams > max anagrams
THEN
max anagrams := anagrams
FI;
e := NEXT words
OD;
print( ( "Maximum number of anagrams: ", whole( max anagrams, -4 ), newline ) );
# show the anagrams with the maximum number #
e := FIRST words;
WHILE e ISNT nil element DO
IF INT anagrams := count( value OF e, separator );
anagrams = max anagrams
THEN
print( ( ( value OF e )[ ( LWB value OF e ) + 1: ], newline ) )
FI;
e := NEXT words
OD
FI

7
Task/Anagrams/APL/anagrams-1.apl Normal file
View file

@ -0,0 +1,7 @@
anagrams←{
tie←⍵ ⎕NTIE 0
dict←⎕NREAD tie 80(⎕NSIZE tie)0
boxes←((⎕UCS 10)≠dict)⊆dict
ana←(({⍵[⍋⍵]}¨boxes)({⍵}⌸)boxes)
({~' '∊¨(⊃/¯1↑[2]⍵)}ana)⌿ana ⋄ ⎕NUNTIE
}

2
Task/Anagrams/APL/anagrams-2.apl Normal file
View file

@ -0,0 +1,2 @@
⎕SH'wget http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'
]display anagrams 'unixdict.txt'

353
Task/Anagrams/ARM-Assembly/anagrams.arm Normal file
View file

@ -0,0 +1,353 @@
/* 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"

26
Task/Anagrams/AWK/anagrams-1.awk Normal file
View file

@ -0,0 +1,26 @@
# JUMBLEA.AWK - words with the most duplicate spellings
# syntax: GAWK -f JUMBLEA.AWK UNIXDICT.TXT
{ for (i=1; i<=NF; i++) {
w = sortstr(toupper($i))
arr[w] = arr[w] $i " "
n = gsub(/ /,"&",arr[w])
if (max_n < n) { max_n = n }
}
}
END {
for (w in arr) {
if (gsub(/ /,"&",arr[w]) == max_n) {
printf("%s\t%s\n",w,arr[w])
}
}
exit(0)
}
function sortstr(str, i,j,leng) {
leng = length(str)
for (i=2; i<=leng; i++) {
for (j=i; j>1 && substr(str,j-1,1) > substr(str,j,1); j--) {
str = substr(str,1,j-2) substr(str,j,1) substr(str,j-1,1) substr(str,j+1)
}
}
return(str)
}

17
Task/Anagrams/AWK/anagrams-2.awk Normal file
View file

@ -0,0 +1,17 @@
#!/bin/gawk -f
{ patsplit($0, chars, ".")
asort(chars)
sorted = ""
for (i = 1; i <= length(chars); i++)
sorted = sorted chars[i]
if (++count[sorted] > countMax) countMax++
accum[sorted] = accum[sorted] " " $0
}
END {
for (i in accum)
if (count[i] == countMax)
print substr(accum[i], 2)
}

69
Task/Anagrams/Ada/anagrams.ada Normal file
View file

@ -0,0 +1,69 @@
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;
procedure Words_Of_Equal_Characters is
package Set_Of_Words is new Ada.Containers.Indefinite_Ordered_Sets (String);
use Ada.Containers, Set_Of_Words;
package Anagrams is new Ada.Containers.Indefinite_Ordered_Maps (String, Set);
use Anagrams;
File : File_Type;
Result : Map;
Max : Count_Type := 1;
procedure Put (Position : Anagrams.Cursor) is
First : Boolean := True;
List : Set renames Element (Position);
procedure Put (Position : Set_Of_Words.Cursor) is
begin
if First then
First := False;
else
Put (',');
end if;
Put (Element (Position));
end Put;
begin
if List.Length = Max then
Iterate (List, Put'Access);
New_Line;
end if;
end Put;
begin
Open (File, In_File, "unixdict.txt");
loop
declare
Word : constant String := Get_Line (File);
Key : String (Word'Range) := (others => Character'Last);
List : Set;
Position : Anagrams.Cursor;
begin
for I in Word'Range loop
for J in Word'Range loop
if Key (J) > Word (I) then
Key (J + 1..I) := Key (J..I - 1);
Key (J) := Word (I);
exit;
end if;
end loop;
end loop;
Position := Find (Result, Key);
if Has_Element (Position) then
List := Element (Position);
Insert (List, Word);
Replace_Element (Result, Position, List);
else
Insert (List, Word);
Include (Result, Key, List);
end if;
Max := Count_Type'Max (Max, Length (List));
end;
end loop;
exception
when End_Error =>
Iterate (Result, Put'Access);
Close (File);
end Words_Of_Equal_Characters;

81
Task/Anagrams/AppleScript/anagrams-1.applescript Normal file
View file

@ -0,0 +1,81 @@
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)

1
Task/Anagrams/AppleScript/anagrams-2.applescript Normal file
View file

@ -0,0 +1 @@
{{"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"}}

14
Task/Anagrams/Arturo/anagrams.arturo Normal file
View file

@ -0,0 +1,14 @@
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

31
Task/Anagrams/AutoHotkey/anagrams.ahk Normal file
View file

@ -0,0 +1,31 @@
FileRead, Contents, unixdict.txt
Loop, Parse, Contents, % "`n", % "`r"
{ ; parsing each line of the file we just read
Loop, Parse, A_LoopField ; parsing each letter/character of the current word
Dummy .= "," A_LoopField
Sort, Dummy, % "D," ; sorting those letters before removing the delimiters (comma)
StringReplace, Dummy, Dummy, % ",", % "", All
List .= "`n" Dummy " " A_LoopField , Dummy := ""
} ; at this point, we have a list where each line looks like <LETTERS><SPACE><WORD>
Count := 0, Contents := "", List := SubStr(List,2)
Sort, List
Loop, Parse, List, % "`n", % "`r"
{ ; now the list is sorted, parse it counting the consecutive lines with the same set of <LETTERS>
Max := (Count > Max) ? Count : Max
StringSplit, LinePart, A_LoopField, % " " ; (LinePart1 are the letters, LinePart2 is the word)
If ( PreviousLinePart1 = LinePart1 )
Count++ , WordList .= "," LinePart2
Else
var_Result .= ( Count <> Max ) ? "" ; don't append if the number of common words is too low
: "`n" Count "`t" PreviousLinePart1 "`t" SubStr(WordList,2)
, WordList := "" , Count := 0
PreviousLinePart1 := LinePart1
}
List := "", var_Result := SubStr(var_Result,2)
Sort, var_Result, R N ; make the higher scores appear first
Loop, Parse, var_Result, % "`n", % "`r"
If ( 1 == InStr(A_LoopField,Max) )
var_Output .= "`n" A_LoopField
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

64
Task/Anagrams/BBC-BASIC/anagrams.basic Normal file
View file

@ -0,0 +1,64 @@
INSTALL @lib$+"SORTLIB"
sort% = FN_sortinit(0,0)
REM Count number of words in dictionary:
nwords% = 0
dict% = OPENIN("unixdict.txt")
WHILE NOT EOF#dict%
word$ = GET$#dict%
nwords% += 1
ENDWHILE
CLOSE #dict%
REM Create arrays big enough to contain the dictionary:
DIM dict$(nwords%), sort$(nwords%)
REM Load the dictionary and sort the characters in the words:
dict% = OPENIN("unixdict.txt")
FOR word% = 1 TO nwords%
word$ = GET$#dict%
dict$(word%) = word$
sort$(word%) = FNsortchars(word$)
NEXT word%
CLOSE #dict%
REM Sort arrays using the 'sorted character' words as a key:
C% = nwords%
CALL sort%, sort$(1), dict$(1)
REM Count the longest sets of anagrams:
max% = 0
set% = 1
FOR word% = 1 TO nwords%-1
IF sort$(word%) = sort$(word%+1) THEN
set% += 1
ELSE
IF set% > max% THEN max% = set%
set% = 1
ENDIF
NEXT word%
REM Output the results:
set% = 1
FOR word% = 1 TO nwords%-1
IF sort$(word%) = sort$(word%+1) THEN
set% += 1
ELSE
IF set% = max% THEN
FOR anagram% = word%-max%+1 TO word%
PRINT dict$(anagram%),;
NEXT
PRINT
ENDIF
set% = 1
ENDIF
NEXT word%
END
DEF FNsortchars(word$)
LOCAL C%, char&()
DIM char&(LEN(word$))
$$^char&(0) = word$
C% = LEN(word$)
CALL sort%, char&(0)
= $$^char&(0)

2
Task/Anagrams/BQN/anagrams-1.bqn Normal file
View file

@ -0,0 +1,2 @@
words ← •FLines "unixdict.txt"
•Show¨{𝕩/˜(⊢=⌈´)≠¨𝕩} (⊐∧¨)⊸⊔ words

6
Task/Anagrams/BQN/anagrams-2.bqn Normal file
View file

@ -0,0 +1,6 @@
⟨ "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" ⟩

20
Task/Anagrams/BaCon/anagrams.bacon Normal file
View file

@ -0,0 +1,20 @@
OPTION COLLAPSE TRUE
DECLARE idx$ ASSOC STRING
FOR w$ IN LOAD$("unixdict.txt") STEP NL$
set$ = SORT$(EXPLODE$(w$, 1))
idx$(set$) = APPEND$(idx$(set$), 0, w$)
total = AMOUNT(idx$(set$))
IF MaxCount < total THEN MaxCount = total
NEXT
PRINT "Analyzing took ", TIMER, " msecs.", NL$
LOOKUP idx$ TO n$ SIZE x
FOR y = 0 TO x-1
IF MaxCount = AMOUNT(idx$(n$[y])) THEN PRINT n$[y], ": ", idx$(n$[y])
NEXT

28
Task/Anagrams/Bracmat/anagrams.bracmat Normal file
View file

@ -0,0 +1,28 @@
( get$("unixdict.txt",STR):?list
& 1:?product
& whl
' ( @(!list:(%?word:?w) \n ?list)
& :?sum
& whl
' ( @(!w:%?let ?w)
& (!let:~#|str$(N !let))+!sum:?sum
)
& !sum^!word*!product:?product
)
& lst$(product,"product.txt",NEW)
& 0:?max
& :?group
& ( !product
: ?
* ?^(%+%:?exp)
* ( ?
& !exp
: ?
+ ( [>!max:[?max&!exp:?group
| [~<!max&!group !exp:?group
)
& ~
)
| out$!group
)
);

35
Task/Anagrams/C++/anagrams.cpp Normal file
View file

@ -0,0 +1,35 @@
#include <iostream>
#include <fstream>
#include <string>
#include <map>
#include <vector>
#include <algorithm>
#include <iterator>
int main() {
std::ifstream in("unixdict.txt");
typedef std::map<std::string, std::vector<std::string> > AnagramMap;
AnagramMap anagrams;
std::string word;
size_t count = 0;
while (std::getline(in, word)) {
std::string key = word;
std::sort(key.begin(), key.end());
// note: the [] op. automatically inserts a new value if key does not exist
AnagramMap::mapped_type & v = anagrams[key];
v.push_back(word);
count = std::max(count, v.size());
}
in.close();
for (AnagramMap::const_iterator it = anagrams.begin(), e = anagrams.end();
it != e; it++)
if (it->second.size() >= count) {
std::copy(it->second.begin(), it->second.end(),
std::ostream_iterator<std::string>(std::cout, ", "));
std::cout << std::endl;
}
return 0;
}

30
Task/Anagrams/C-sharp/anagrams.cs Normal file
View file

@ -0,0 +1,30 @@
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));
}
}
}
}

160
Task/Anagrams/C/anagrams-1.c Normal file
View file

@ -0,0 +1,160 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <time.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 = malloc(sizeof(struct sHashEntry));
he->next = NULL;
he->key = strdup(hkey);
he->wordCount = 0;
he->words = NULL;
he->link = NULL;
*hep = he;
}
we = 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;
}
int main( )
{
HashEntry he;
DictWord we;
FILE *f1;
f1 = fopen("unixdict.txt","r");
buildAnagrams(f1);
fclose(f1);
f1 = fopen("anaout.txt","w");
// f1 = stdout;
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);
return 0;
}

101
Task/Anagrams/C/anagrams-2.c Normal file
View file

@ -0,0 +1,101 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
#include <unistd.h>
#include <sys/stat.h>
#include <string.h>
typedef struct { const char *key, *word; int cnt; } kw_t;
int lst_cmp(const void *a, const void *b)
{
return strcmp(((const kw_t*)a)->key, ((const kw_t*)b)->key);
}
/* Bubble sort. Faster than stock qsort(), believe it or not */
void sort_letters(char *s)
{
int i, j;
char t;
for (i = 0; s[i] != '\0'; i++) {
for (j = i + 1; s[j] != '\0'; j++)
if (s[j] < s[i]) {
t = s[j]; s[j] = s[i]; s[i] = t;
}
}
}
int main()
{
struct stat s;
char *words, *keys;
size_t i, j, k, longest, offset;
int n_word = 0;
kw_t *list;
int fd = open("unixdict.txt", O_RDONLY);
if (fd == -1) return 1;
fstat(fd, &s);
words = malloc(s.st_size * 2);
keys = words + s.st_size;
read(fd, words, s.st_size);
memcpy(keys, words, s.st_size);
/* change newline to null for easy use; sort letters in keys */
for (i = j = 0; i < s.st_size; i++) {
if (words[i] == '\n') {
words[i] = keys[i] = '\0';
sort_letters(keys + j);
j = i + 1;
n_word ++;
}
}
list = calloc(n_word, sizeof(kw_t));
/* make key/word pointer pairs for sorting */
for (i = j = k = 0; i < s.st_size; i++) {
if (words[i] == '\0') {
list[j].key = keys + k;
list[j].word = words + k;
k = i + 1;
j++;
}
}
qsort(list, n_word, sizeof(kw_t), lst_cmp);
/* count each key's repetition */
for (i = j = k = offset = longest = 0; i < n_word; i++) {
if (!strcmp(list[i].key, list[j].key)) {
++k;
continue;
}
/* move current longest to begining of array */
if (k < longest) {
k = 0;
j = i;
continue;
}
if (k > longest) offset = 0;
while (j < i) list[offset++] = list[j++];
longest = k;
k = 0;
}
/* show the longest */
for (i = 0; i < offset; i++) {
printf("%s ", list[i].word);
if (i < n_word - 1 && strcmp(list[i].key, list[i+1].key))
printf("\n");
}
/* free(list); free(words); */
close(fd);
return 0;
}

83
Task/Anagrams/CLU/anagrams.clu Normal file
View file

@ -0,0 +1,83 @@
% 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

243
Task/Anagrams/COBOL/anagrams.cobol Normal file
View file

@ -0,0 +1,243 @@
*> TECTONICS
*> wget http://wiki.puzzlers.org/pub/wordlists/unixdict.txt
*> or visit https://sourceforge.net/projects/souptonuts/files
*> or snag ftp://ftp.openwall.com/pub/wordlists/all.gz
*> for a 5 million all language word file (a few phrases)
*> cobc -xj anagrams.cob [-DMOSTWORDS -DMOREWORDS -DALLWORDS]
*> ***************************************************************
identification division.
program-id. anagrams.
environment division.
configuration section.
repository.
function all intrinsic.
input-output section.
file-control.
select words-in
assign to wordfile
organization is line sequential
status is words-status
.
REPLACE ==:LETTERS:== BY ==42==.
data division.
file section.
fd words-in record is varying from 1 to :LETTERS: characters
depending on word-length.
01 word-record.
05 word-data pic x occurs 0 to :LETTERS: times
depending on word-length.
working-storage section.
>>IF ALLWORDS DEFINED
01 wordfile constant as "/usr/local/share/dict/all.words".
01 max-words constant as 4802100.
>>ELSE-IF MOSTWORDS DEFINED
01 wordfile constant as "/usr/local/share/dict/linux.words".
01 max-words constant as 628000.
>>ELSE-IF MOREWORDS DEFINED
01 wordfile constant as "/usr/share/dict/words".
01 max-words constant as 100000.
>>ELSE
01 wordfile constant as "unixdict.txt".
01 max-words constant as 26000.
>>END-IF
*> The 5 million word file needs to restrict the word length
>>IF ALLWORDS DEFINED
01 max-letters constant as 26.
>>ELSE
01 max-letters constant as :LETTERS:.
>>END-IF
01 word-length pic 99 comp-5.
01 words-status pic xx.
88 ok-status values '00' thru '09'.
88 eof-status value '10'.
*> sortable word by letter table
01 letter-index usage index.
01 letter-table.
05 letters occurs 1 to max-letters times
depending on word-length
ascending key letter
indexed by letter-index.
10 letter pic x.
*> table of words
01 sorted-index usage index.
01 word-table.
05 word-list occurs 0 to max-words times
depending on word-tally
ascending key sorted-word
indexed by sorted-index.
10 match-count pic 999 comp-5.
10 this-word pic x(max-letters).
10 sorted-word pic x(max-letters).
01 sorted-display pic x(10).
01 interest-table.
05 interest-list pic 9(8) comp-5
occurs 0 to max-words times
depending on interest-tally.
01 outer pic 9(8) comp-5.
01 inner pic 9(8) comp-5.
01 starter pic 9(8) comp-5.
01 ender pic 9(8) comp-5.
01 word-tally pic 9(8) comp-5.
01 interest-tally pic 9(8) comp-5.
01 tally-display pic zz,zzz,zz9.
01 most-matches pic 99 comp-5.
01 matches pic 99 comp-5.
01 match-display pic z9.
*> timing display
01 time-stamp.
05 filler pic x(11).
05 timer-hours pic 99.
05 filler pic x.
05 timer-minutes pic 99.
05 filler pic x.
05 timer-seconds pic 99.
05 filler pic x.
05 timer-subsec pic v9(6).
01 timer-elapsed pic 9(6)v9(6).
01 timer-value pic 9(6)v9(6).
01 timer-display pic zzz,zz9.9(6).
*> ***************************************************************
procedure division.
main-routine.
>>IF ALLWORDS DEFINED
display "** Words limited to " max-letters " letters **"
>>END-IF
perform show-time
perform load-words
perform find-most
perform display-result
perform show-time
goback
.
*> ***************************************************************
load-words.
open input words-in
if not ok-status then
display "error opening " wordfile upon syserr
move 1 to return-code
goback
end-if
perform until exit
read words-in
if eof-status then exit perform end-if
if not ok-status then
display wordfile " read error: " words-status upon syserr
end-if
if word-length equal zero then exit perform cycle end-if
>>IF ALLWORDS DEFINED
move min(word-length, max-letters) to word-length
>>END-IF
add 1 to word-tally
move word-record to this-word(word-tally) letter-table
sort letters ascending key letter
move letter-table to sorted-word(word-tally)
end-perform
move word-tally to tally-display
display trim(tally-display) " words" with no advancing
close words-in
if not ok-status then
display "error closing " wordfile upon syserr
move 1 to return-code
end-if
*> sort word list by anagram check field
sort word-list ascending key sorted-word
.
*> first entry in a list will end up with highest match count
find-most.
perform varying outer from 1 by 1 until outer > word-tally
move 1 to matches
add 1 to outer giving starter
perform varying inner from starter by 1
until sorted-word(inner) not equal sorted-word(outer)
add 1 to matches
end-perform
if matches > most-matches then
move matches to most-matches
initialize interest-table all to value
move 0 to interest-tally
end-if
move matches to match-count(outer)
if matches = most-matches then
add 1 to interest-tally
move outer to interest-list(interest-tally)
end-if
end-perform
.
*> only display the words with the most anagrams
display-result.
move interest-tally to tally-display
move most-matches to match-display
display ", most anagrams: " trim(match-display)
", with " trim(tally-display) " set" with no advancing
if interest-tally not equal 1 then
display "s" with no advancing
end-if
display " of interest"
perform varying outer from 1 by 1 until outer > interest-tally
move sorted-word(interest-list(outer)) to sorted-display
display sorted-display
" [" trim(this-word(interest-list(outer)))
with no advancing
add 1 to interest-list(outer) giving starter
add most-matches to interest-list(outer) giving ender
perform varying inner from starter by 1
until inner = ender
display ", " trim(this-word(inner))
with no advancing
end-perform
display "]"
end-perform
.
*> elapsed time
show-time.
move formatted-current-date("YYYY-MM-DDThh:mm:ss.ssssss")
to time-stamp
compute timer-value = timer-hours * 3600 + timer-minutes * 60
+ timer-seconds + timer-subsec
if timer-elapsed = 0 then
display time-stamp
move timer-value to timer-elapsed
else
if timer-value < timer-elapsed then
add 86400 to timer-value
end-if
subtract timer-elapsed from timer-value
move timer-value to timer-display
display time-stamp ", " trim(timer-display) " seconds"
end-if
.
end program anagrams.

10
Task/Anagrams/Clojure/anagrams-1.clj Normal file
View file

@ -0,0 +1,10 @@
(require '[clojure.java.io :as io])
(def groups
(with-open [r (io/reader wordfile)]
(group-by sort (line-seq r))))
(let [wordlists (sort-by (comp - count) (vals groups))
maxlength (count (first wordlists))]
(doseq [wordlist (take-while #(= (count %) maxlength) wordlists)]
(println wordlist))

14
Task/Anagrams/Clojure/anagrams-2.clj Normal file
View file

@ -0,0 +1,14 @@
(->> (slurp "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
clojure.string/split-lines
(group-by sort)
vals
(sort-by count >) ;; sort in reverse
(partition-by count)
first)
;; (["caret" "carte" "cater" "crate" "trace"]
;; ["angel" "angle" "galen" "glean" "lange"]
;; ["elan" "lane" "lean" "lena" "neal"]
;; ["alger" "glare" "lager" "large" "regal"]
;; ["evil" "levi" "live" "veil" "vile"]
;; ["abel" "able" "bale" "bela" "elba"])

31
Task/Anagrams/CoffeeScript/anagrams-1.coffee Normal file
View file

@ -0,0 +1,31 @@
http = require 'http'
show_large_anagram_sets = (word_lst) ->
anagrams = {}
max_size = 0
for word in word_lst
key = word.split('').sort().join('')
anagrams[key] ?= []
anagrams[key].push word
size = anagrams[key].length
max_size = size if size > max_size
for key, variations of anagrams
if variations.length == max_size
console.log variations.join ' '
get_word_list = (process) ->
options =
host: "wiki.puzzlers.org"
path: "/pub/wordlists/unixdict.txt"
req = http.request options, (res) ->
s = ''
res.on 'data', (chunk) ->
s += chunk
res.on 'end', ->
process s.split '\n'
req.end()
get_word_list show_large_anagram_sets

7
Task/Anagrams/CoffeeScript/anagrams-2.coffee Normal file
View file

@ -0,0 +1,7 @@
> coffee anagrams.coffee
[ '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' ]

23
Task/Anagrams/Common-Lisp/anagrams-1.lisp Normal file
View file

@ -0,0 +1,23 @@
(defun anagrams (&optional (url "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"))
(let ((words (drakma:http-request url :want-stream t))
(wordsets (make-hash-table :test 'equalp)))
;; populate the wordsets and close stream
(do ((word (read-line words nil nil) (read-line words nil nil)))
((null word) (close words))
(let ((letters (sort (copy-seq word) 'char<)))
(multiple-value-bind (pair presentp)
(gethash letters wordsets)
(if presentp
(setf (car pair) (1+ (car pair))
(cdr pair) (cons word (cdr pair)))
(setf (gethash letters wordsets)
(cons 1 (list word)))))))
;; find and return the biggest wordsets
(loop with maxcount = 0 with maxwordsets = '()
for pair being each hash-value of wordsets
if (> (car pair) maxcount)
do (setf maxcount (car pair)
maxwordsets (list (cdr pair)))
else if (eql (car pair) maxcount)
do (push (cdr pair) maxwordsets)
finally (return (values maxwordsets maxcount)))))

3
Task/Anagrams/Common-Lisp/anagrams-2.lisp Normal file
View file

@ -0,0 +1,3 @@
(multiple-value-bind (wordsets count) (anagrams)
(pprint wordsets)
(print count))

19
Task/Anagrams/Common-Lisp/anagrams-3.lisp Normal file
View file

@ -0,0 +1,19 @@
(defun read-words (file)
(with-open-file (stream file)
(loop with w = "" while w collect (setf w (read-line stream nil)))))
(defun anagram (file)
(let ((wordlist (read-words file))
(h (make-hash-table :test #'equal))
longest)
(loop for w in wordlist with ws do
(setf ws (sort (copy-seq w) #'char<))
(setf (gethash ws h) (cons w (gethash ws h))))
(loop for w being the hash-keys in h using (hash-value wl)
with max-len = 0 do
(let ((l (length wl)))
(if (> l max-len) (setf longest nil max-len l))
(if (= l max-len) (push wl longest))))
longest))
(format t "~{~{~a ~}~^~%~}" (anagram "unixdict.txt"))

175
Task/Anagrams/Component-Pascal/anagrams.pas Normal file
View file

@ -0,0 +1,175 @@
MODULE BbtAnagrams;
IMPORT StdLog,Files,Strings,Args;
CONST
MAXPOOLSZ = 1024;
TYPE
Node = POINTER TO LIMITED RECORD;
count: INTEGER;
word: Args.String;
desc: Node;
next: Node;
END;
Pool = POINTER TO LIMITED RECORD
capacity,max: INTEGER;
words: POINTER TO ARRAY OF Node;
END;
PROCEDURE NewNode(word: ARRAY OF CHAR): Node;
VAR
n: Node;
BEGIN
NEW(n);n.count := 0;n.word := word$;
n.desc := NIL;n.next := NIL;
RETURN n
END NewNode;
PROCEDURE Index(s: ARRAY OF CHAR;cap: INTEGER): INTEGER;
VAR
i,sum: INTEGER;
BEGIN
sum := 0;
FOR i := 0 TO LEN(s$) DO
INC(sum,ORD(s[i]))
END;
RETURN sum MOD cap
END Index;
PROCEDURE ISort(VAR s: ARRAY OF CHAR);
VAR
i, j: INTEGER;
t: CHAR;
BEGIN
FOR i := 0 TO LEN(s$) - 1 DO
j := i;
t := s[j];
WHILE (j > 0) & (s[j -1] > t) DO
s[j] := s[j - 1];
DEC(j)
END;
s[j] := t
END
END ISort;
PROCEDURE SameLetters(x,y: ARRAY OF CHAR): BOOLEAN;
BEGIN
ISort(x);ISort(y);
RETURN x = y
END SameLetters;
PROCEDURE NewPoolWith(cap: INTEGER): Pool;
VAR
i: INTEGER;
p: Pool;
BEGIN
NEW(p);
p.capacity := cap;
p.max := 0;
NEW(p.words,cap);
i := 0;
WHILE i < p.capacity DO
p.words[i] := NIL;
INC(i);
END;
RETURN p
END NewPoolWith;
PROCEDURE NewPool(): Pool;
BEGIN
RETURN NewPoolWith(MAXPOOLSZ);
END NewPool;
PROCEDURE (p: Pool) Add(w: ARRAY OF CHAR), NEW;
VAR
idx: INTEGER;
iter,n: Node;
BEGIN
idx := Index(w,p.capacity);
iter := p.words[idx];
n := NewNode(w);
WHILE(iter # NIL) DO
IF SameLetters(w,iter.word) THEN
INC(iter.count);
IF iter.count > p.max THEN p.max := iter.count END;
n.desc := iter.desc;
iter.desc := n;
RETURN
END;
iter := iter.next
END;
ASSERT(iter = NIL);
n.next := p.words[idx];p.words[idx] := n
END Add;
PROCEDURE ShowAnagrams(l: Node);
VAR
iter: Node;
BEGIN
iter := l;
WHILE iter # NIL DO
StdLog.String(iter.word);StdLog.String(" ");
iter := iter.desc
END;
StdLog.Ln
END ShowAnagrams;
PROCEDURE (p: Pool) ShowMax(),NEW;
VAR
i: INTEGER;
iter: Node;
BEGIN
FOR i := 0 TO LEN(p.words) - 1 DO
IF p.words[i] # NIL THEN
iter := p.words^[i];
WHILE iter # NIL DO
IF iter.count = p.max THEN
ShowAnagrams(iter);
END;
iter := iter.next
END
END
END
END ShowMax;
PROCEDURE GetLine(rd: Files.Reader; OUT str: ARRAY OF CHAR);
VAR
i: INTEGER;
b: BYTE;
BEGIN
rd.ReadByte(b);i := 0;
WHILE (~rd.eof) & (i < LEN(str)) DO
IF (b = ORD(0DX)) OR (b = ORD(0AX)) THEN str[i] := 0X; RETURN END;
str[i] := CHR(b);
rd.ReadByte(b);INC(i)
END;
str[LEN(str) - 1] := 0X
END GetLine;
PROCEDURE DoProcess*;
VAR
params : Args.Params;
loc: Files.Locator;
fd: Files.File;
rd: Files.Reader;
line: ARRAY 81 OF CHAR;
p: Pool;
BEGIN
Args.Get(params);
IF params.argc = 1 THEN
loc := Files.dir.This("Bbt");
fd := Files.dir.Old(loc,params.args[0]$,FALSE);
StdLog.String("Processing: " + params.args[0]);StdLog.Ln;StdLog.Ln;
rd := fd.NewReader(NIL);
p := NewPool();
REPEAT
GetLine(rd,line);
p.Add(line);
UNTIL rd.eof;
p.ShowMax()
ELSE
StdLog.String("Error: Missing file to process");StdLog.Ln
END;
END DoProcess;
END BbtAnagrams.

22
Task/Anagrams/Crystal/anagrams.crystal Normal file
View file

@ -0,0 +1,22 @@
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

9
Task/Anagrams/D/anagrams-1.d Normal file
View file

@ -0,0 +1,9 @@
import std.stdio, std.algorithm, std.string, std.exception, std.file;
void main() {
string[][ubyte[]] an;
foreach (w; "unixdict.txt".readText.splitLines)
an[w.dup.representation.sort().release.assumeUnique] ~= w;
immutable m = an.byValue.map!q{ a.length }.reduce!max;
writefln("%(%s\n%)", an.byValue.filter!(ws => ws.length == m));
}

14
Task/Anagrams/D/anagrams-2.d Normal file
View file

@ -0,0 +1,14 @@
void main() {
import std.stdio, std.algorithm, std.file, std.string;
auto keys = "unixdict.txt".readText!(char[]);
immutable vals = keys.idup;
string[][string] anags;
foreach (w; keys.splitter) {
immutable k = w.representation.sort().release.assumeUTF;
anags[k] ~= vals[k.ptr - keys.ptr .. k.ptr - keys.ptr + k.length];
}
//immutable m = anags.byValue.maxs!q{ a.length };
immutable m = anags.byValue.map!q{ a.length }.reduce!max;
writefln("%(%-(%s %)\n%)", anags.byValue.filter!(ws => ws.length == m));
}

125
Task/Anagrams/Delphi/anagrams.delphi Normal file
View file

@ -0,0 +1,125 @@
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.

22
Task/Anagrams/E/anagrams.e Normal file
View file

@ -0,0 +1,22 @@
println("Downloading...")
when (def wordText := <http://wiki.puzzlers.org/pub/wordlists/unixdict.txt> <- getText()) -> {
def words := wordText.split("\n")
def storage := [].asMap().diverge()
def anagramTable extends storage {
to get(key) { return storage.fetch(key, fn { storage[key] := [].diverge() }) }
}
println("Grouping...")
var largestGroupSeen := 0
for word in words {
def anagramGroup := anagramTable[word.sort()]
anagramGroup.push(word)
largestGroupSeen max= anagramGroup.size()
}
println("Selecting...")
for _ => anagramGroup ? (anagramGroup.size() == mostSeen) in anagramTable {
println(anagramGroup.snapshot())
}
}

35
Task/Anagrams/EchoLisp/anagrams-1.l Normal file
View file

@ -0,0 +1,35 @@
(require 'struct)
(require 'hash)
(require 'sql)
(require 'words)
(require 'dico.fr.no-accent)
(define mots-français (words-select #:any null 999999))
(string-delimiter "")
(define (string-sort str)
(list->string (list-sort string<? (string->list str))))
(define (ana-sort H words) ;; bump counter for each word
(for ((w words))
#:continue (< (string-length w) 4)
(let [(key (string-sort w))] (hash-set H key (1+ (hash-ref! H key 0))))))
;; input w word
;; output : list of matching words
(define (anagrams w words)
(set! w (string-sort w))
(make-set
(for/list (( ana words))
#:when (string=? w (string-sort ana))
ana)))
(define (task words)
(define H (make-hash))
(ana-sort H words) ;; build counters key= sorted-string, value = count
(hash-get-keys H ;; extract max count values
(for/fold (hmax 0) ((h H) )
#:when (>= (cdr h) hmax)
(cdr h))
))

8
Task/Anagrams/EchoLisp/anagrams-2.l Normal file
View file

@ -0,0 +1,8 @@
(length mots-français)
→ 209315
(task mots-français)
→ (aeilns acenr) ;; two winners
(anagrams "acenr" mots-français)
→ { ancre caner caren carne ceran cerna encra nacre nerac rance renac }
(anagrams "aeilns" mots-français)
→ { alisen enlias enlisa ensila islaen islean laines lianes salien saline selina }

87
Task/Anagrams/Eiffel/anagrams.e Normal file
View file

@ -0,0 +1,87 @@
class
ANAGRAMS
create
make
feature
make
-- Set of Anagrams, containing most words.
local
count: INTEGER
do
read_wordlist
across
words as wo
loop
if wo.item.count > count then
count := wo.item.count
end
end
across
words as wo
loop
if wo.item.count = count then
across
wo.item as list
loop
io.put_string (list.item + "%T")
end
io.new_line
end
end
end
original_list: STRING = "unixdict.txt"
feature {NONE}
read_wordlist
-- Preprocessed wordlist for finding Anagrams.
local
l_file: PLAIN_TEXT_FILE
sorted: STRING
empty_list: LINKED_LIST [STRING]
do
create l_file.make_open_read_write (original_list)
l_file.read_stream (l_file.count)
wordlist := l_file.last_string.split ('%N')
l_file.close
create words.make (wordlist.count)
across
wordlist as w
loop
create empty_list.make
sorted := sort_letters (w.item)
words.put (empty_list, sorted)
if attached words.at (sorted) as ana then
ana.extend (w.item)
end
end
end
wordlist: LIST [STRING]
sort_letters (word: STRING): STRING
--Sorted in alphabetical order.
local
letters: SORTED_TWO_WAY_LIST [STRING]
do
create letters.make
create Result.make_empty
across
1 |..| word.count as i
loop
letters.extend (word.at (i.item).out)
end
across
letters as s
loop
Result.append (s.item)
end
end
words: HASH_TABLE [LINKED_LIST [STRING], STRING]
end

14
Task/Anagrams/Ela/anagrams.ela Normal file
View file

@ -0,0 +1,14 @@
open monad io list string
groupon f x y = f x == f y
lines = split "\n" << replace "\n\n" "\n" << replace "\r" "\n"
main = do
fh <- readFile "c:\\test\\unixdict.txt" OpenMode
f <- readLines fh
closeFile fh
let words = lines f
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

46
Task/Anagrams/Elena/anagrams.elena Normal file
View file

@ -0,0 +1,46 @@
import system'routines;
import system'calendar;
import system'io;
import system'collections;
import extensions;
import extensions'routines;
import extensions'text;
extension op
{
string normalized()
= self.toArray().ascendant().summarize(new StringWriter());
}
public program()
{
var start := now;
auto dictionary := new Map<string,object>();
File.assign("unixdict.txt").forEachLine:(word)
{
var key := word.normalized();
var item := dictionary[key];
if (nil == item)
{
item := new ArrayList();
dictionary[key] := item
};
item.append:word
};
dictionary.Values
.sort:(former,later => former.Item2.Length > later.Item2.Length )
.top:20
.forEach:(pair){ console.printLine(pair.Item2) };
var end := now;
var diff := end - start;
console.printLine("Time elapsed in msec:",diff.Milliseconds);
console.readChar()
}

16
Task/Anagrams/Elixir/anagrams-1.elixir Normal file
View file

@ -0,0 +1,16 @@
defmodule Anagrams do
def find(file) do
File.read!(file)
|> String.split
|> Enum.group_by(fn word -> String.codepoints(word) |> Enum.sort end)
|> Enum.group_by(fn {_,v} -> length(v) end)
|> Enum.max
|> print
end
defp print({_,y}) do
Enum.each(y, fn {_,e} -> Enum.sort(e) |> Enum.join(" ") |> IO.puts end)
end
end
Anagrams.find("unixdict.txt")

8
Task/Anagrams/Elixir/anagrams-2.elixir Normal file
View file

@ -0,0 +1,8 @@
File.stream!("unixdict.txt")
|> Stream.map(&String.strip &1)
|> Enum.group_by(&String.codepoints(&1) |> Enum.sort)
|> Map.values
|> Enum.group_by(&length &1)
|> Enum.max
|> elem(1)
|> Enum.each(fn n -> Enum.sort(n) |> Enum.join(" ") |> IO.puts end)

29
Task/Anagrams/Erlang/anagrams.erl Normal file
View file

@ -0,0 +1,29 @@
-module(anagrams).
-compile(export_all).
play() ->
{ok, P} = file:read_file('unixdict.txt'),
D = dict:new(),
E=fetch(string:tokens(binary_to_list(P), "\n"), D),
get_value(dict:fetch_keys(E), E).
fetch([H|T], D) ->
fetch(T, dict:append(lists:sort(H), H, D));
fetch([], D) ->
D.
get_value(L, D) -> get_value(L,D,1,[]).
get_value([H|T], D, N, L) ->
Var = dict:fetch(H,D),
Len = length(Var),
if
Len > N ->
get_value(T, D, Len, [Var]);
Len == N ->
get_value(T, D, Len, [Var | L]);
Len < N ->
get_value(T, D, N, L)
end;
get_value([], _, _, L) ->
L.

49
Task/Anagrams/Euphoria/anagrams.euphoria Normal file
View file

@ -0,0 +1,49 @@
include sort.e
function compare_keys(sequence a, sequence b)
return compare(a[1],b[1])
end function
constant fn = open("unixdict.txt","r")
sequence words, anagrams
object word
words = {}
while 1 do
word = gets(fn)
if atom(word) then
exit
end if
word = word[1..$-1] -- truncate new-line character
words = append(words, {sort(word), word})
end while
close(fn)
integer maxlen
maxlen = 0
words = custom_sort(routine_id("compare_keys"), words)
anagrams = {words[1]}
for i = 2 to length(words) do
if equal(anagrams[$][1],words[i][1]) then
anagrams[$] = append(anagrams[$], words[i][2])
elsif length(anagrams[$]) = 2 then
anagrams[$] = words[i]
else
if length(anagrams[$]) > maxlen then
maxlen = length(anagrams[$])
end if
anagrams = append(anagrams, words[i])
end if
end for
if length(anagrams[$]) = 2 then
anagrams = anagrams[1..$-1]
end if
for i = 1 to length(anagrams) do
if length(anagrams[i]) = maxlen then
for j = 2 to length(anagrams[i]) do
puts(1,anagrams[i][j])
puts(1,' ')
end for
puts(1,"\n")
end if
end for

2
Task/Anagrams/F-Sharp/anagrams-1.fs Normal file
View file

@ -0,0 +1,2 @@
let xss = Seq.groupBy (Array.ofSeq >> Array.sort) (System.IO.File.ReadAllLines "unixdict.txt")
Seq.map snd xss |> Seq.filter (Seq.length >> ( = ) (Seq.map (snd >> Seq.length) xss |> Seq.max))

8
Task/Anagrams/F-Sharp/anagrams-2.fs Normal file
View file

@ -0,0 +1,8 @@
val it : string seq seq =
seq
[seq ["abel"; "able"; "bale"; "bela"; "elba"];
seq ["alger"; "glare"; "lager"; "large"; "regal"];
seq ["angel"; "angle"; "galen"; "glean"; "lange"];
seq ["caret"; "carte"; "cater"; "crate"; "trace"];
seq ["elan"; "lane"; "lean"; "lena"; "neal"];
seq ["evil"; "levi"; "live"; "veil"; "vile"]]

160
Task/Anagrams/FBSL/anagrams.fbsl Normal file
View file

@ -0,0 +1,160 @@
#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

4
Task/Anagrams/Factor/anagrams-1.factor Normal file
View file

@ -0,0 +1,4 @@
"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 .

8
Task/Anagrams/Factor/anagrams-2.factor Normal file
View file

@ -0,0 +1,8 @@
{
{ "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" }
}

43
Task/Anagrams/Fantom/anagrams.fantom Normal file
View file

@ -0,0 +1,43 @@
class Main
{
// take given word and return a string rearranging characters in order
static Str toOrderedChars (Str word)
{
Str[] chars := [,]
word.each |Int c| { chars.add (c.toChar) }
return chars.sort.join("")
}
// add given word to anagrams map
static Void addWord (Str:Str[] anagrams, Str word)
{
Str orderedWord := toOrderedChars (word)
if (anagrams.containsKey (orderedWord))
anagrams[orderedWord].add (word)
else
anagrams[orderedWord] = [word]
}
public static Void main ()
{
Str:Str[] anagrams := [:] // map Str -> Str[]
// loop through input file, adding each word to map of anagrams
File (`unixdict.txt`).eachLine |Str word|
{
addWord (anagrams, word)
}
// loop through anagrams, keeping the keys with values of largest size
Str[] largestKeys := [,]
anagrams.keys.each |Str k|
{
if ((largestKeys.size < 1) || (anagrams[k].size == anagrams[largestKeys[0]].size))
largestKeys.add (k)
else if (anagrams[k].size > anagrams[largestKeys[0]].size)
largestKeys = [k]
}
largestKeys.each |Str k|
{
echo ("Key: $k -> " + anagrams[k].join(", "))
}
}
}

175
Task/Anagrams/Fortran/anagrams.f Normal file
View file

@ -0,0 +1,175 @@
!***************************************************************************************
module anagram_routines
!***************************************************************************************
implicit none
!the dictionary file:
integer,parameter :: file_unit = 1000
character(len=*),parameter :: filename = 'unixdict.txt'
!maximum number of characters in a word:
integer,parameter :: max_chars = 50
!maximum number of characters in the string displaying the anagram lists:
integer,parameter :: str_len = 256
type word
character(len=max_chars) :: str = repeat(' ',max_chars) !the word from the dictionary
integer :: n = 0 !length of this word
integer :: n_anagrams = 0 !number of anagrams found
logical :: checked = .false. !if this one has already been checked
character(len=str_len) :: anagrams = repeat(' ',str_len) !the anagram list for this word
end type word
!the dictionary structure:
type(word),dimension(:),allocatable,target :: dict
contains
!***************************************************************************************
!******************************************************************************
function count_lines_in_file(fid) result(n_lines)
!******************************************************************************
implicit none
integer :: n_lines
integer,intent(in) :: fid
character(len=1) :: tmp
integer :: i
integer :: ios
!the file is assumed to be open already.
rewind(fid) !rewind to beginning of the file
n_lines = 0
do !read each line until the end of the file.
read(fid,'(A1)',iostat=ios) tmp
if (ios < 0) exit !End of file
n_lines = n_lines + 1 !row counter
end do
rewind(fid) !rewind to beginning of the file
!******************************************************************************
end function count_lines_in_file
!******************************************************************************
!******************************************************************************
pure elemental function is_anagram(x,y)
!******************************************************************************
implicit none
character(len=*),intent(in) :: x
character(len=*),intent(in) :: y
logical :: is_anagram
character(len=len(x)) :: x_tmp !a copy of x
integer :: i,j
!a character not found in any word:
character(len=1),parameter :: null = achar(0)
!x and y are assumed to be the same size.
x_tmp = x
do i=1,len_trim(x)
j = index(x_tmp, y(i:i)) !look for this character in x_tmp
if (j/=0) then
x_tmp(j:j) = null !clear it so it won't be checked again
else
is_anagram = .false. !character not found: x,y are not anagrams
return
end if
end do
!if we got to this point, all the characters
! were the same, so x,y are anagrams:
is_anagram = .true.
!******************************************************************************
end function is_anagram
!******************************************************************************
!***************************************************************************************
end module anagram_routines
!***************************************************************************************
!***************************************************************************************
program main
!***************************************************************************************
use anagram_routines
implicit none
integer :: n,i,j,n_max
type(word),pointer :: x,y
logical :: first_word
real :: start, finish
call cpu_time(start) !..start timer
!open the dictionary and read in all the words:
open(unit=file_unit,file=filename) !open the file
n = count_lines_in_file(file_unit) !count lines in the file
allocate(dict(n)) !allocate dictionary structure
do i=1,n !
read(file_unit,'(A)') dict(i)%str !each line is a word in the dictionary
dict(i)%n = len_trim(dict(i)%str) !saving length here to avoid trim's below
end do
close(file_unit) !close the file
!search dictionary for anagrams:
do i=1,n
x => dict(i) !pointer to simplify code
first_word = .true. !initialize
do j=i,n
y => dict(j) !pointer to simplify code
!checks to avoid checking words unnecessarily:
if (x%checked .or. y%checked) cycle !both must not have been checked already
if (x%n/=y%n) cycle !must be the same size
if (x%str(1:x%n)==y%str(1:y%n)) cycle !can't be the same word
! check to see if x,y are anagrams:
if (is_anagram(x%str(1:x%n), y%str(1:y%n))) then
!they are anagrams.
y%checked = .true. !don't check this one again.
x%n_anagrams = x%n_anagrams + 1
if (first_word) then
!this is the first anagram found for this word.
first_word = .false.
x%n_anagrams = x%n_anagrams + 1
x%anagrams = trim(x%anagrams)//x%str(1:x%n) !add first word to list
end if
x%anagrams = trim(x%anagrams)//','//y%str(1:y%n) !add next word to list
end if
end do
x%checked = .true. !don't check this one again
end do
!anagram groups with the most words:
write(*,*) ''
n_max = maxval(dict%n_anagrams)
do i=1,n
if (dict(i)%n_anagrams==n_max) write(*,'(A)') trim(dict(i)%anagrams)
end do
!anagram group containing longest words:
write(*,*) ''
n_max = maxval(dict%n, mask=dict%n_anagrams>0)
do i=1,n
if (dict(i)%n_anagrams>0 .and. dict(i)%n==n_max) write(*,'(A)') trim(dict(i)%anagrams)
end do
write(*,*) ''
call cpu_time(finish) !...stop timer
write(*,'(A,F6.3,A)') '[Runtime = ',finish-start,' sec]'
write(*,*) ''
!***************************************************************************************
end program main
!***************************************************************************************

136
Task/Anagrams/FreeBASIC/anagrams.basic Normal file
View file

@ -0,0 +1,136 @@
' FB 1.05.0 Win64
Type IndexedWord
As String word
As Integer index
End Type
' selection sort, quick enough for sorting small number of letters
Sub sortWord(s As String)
Dim As Integer i, j, m, n = Len(s)
For i = 0 To n - 2
m = i
For j = i + 1 To n - 1
If s[j] < s[m] Then m = j
Next j
If m <> i Then Swap s[i], s[m]
Next i
End Sub
' selection sort, quick enough for sorting small array of IndexedWord instances by index
Sub sortIndexedWord(iw() As IndexedWord)
Dim As Integer i, j, m, n = UBound(iw)
For i = 1 To n - 1
m = i
For j = i + 1 To n
If iw(j).index < iw(m).index Then m = j
Next j
If m <> i Then Swap iw(i), iw(m)
Next i
End Sub
' quicksort for sorting whole dictionary of IndexedWord instances by sorted word
Sub quicksort(a() As IndexedWord, first As Integer, last As Integer)
Dim As Integer length = last - first + 1
If length < 2 Then Return
Dim pivot As String = a(first + length\ 2).word
Dim lft As Integer = first
Dim rgt As Integer = last
While lft <= rgt
While a(lft).word < pivot
lft +=1
Wend
While a(rgt).word > pivot
rgt -= 1
Wend
If lft <= rgt Then
Swap a(lft), a(rgt)
lft += 1
rgt -= 1
End If
Wend
quicksort(a(), first, rgt)
quicksort(a(), lft, last)
End Sub
Dim t As Double = timer
Dim As String w() '' array to hold actual words
Open "undict.txt" For Input As #1
Dim count As Integer = 0
While Not Eof(1)
count +=1
Redim Preserve w(1 To count)
Line Input #1, w(count)
Wend
Close #1
Dim As IndexedWord iw(1 To count) '' array to hold sorted words and their index into w()
Dim word As String
For i As Integer = 1 To count
word = w(i)
sortWord(word)
iw(i).word = word
iw(i).index = i
Next
quickSort iw(), 1, count '' sort the IndexedWord array by sorted word
Dim As Integer startIndex = 1, length = 1, maxLength = 1, ub = 1
Dim As Integer maxIndex(1 To ub)
maxIndex(ub) = 1
word = iw(1).word
For i As Integer = 2 To count
If word = iw(i).word Then
length += 1
Else
If length > maxLength Then
maxLength = length
Erase maxIndex
ub = 1
Redim maxIndex(1 To ub)
maxIndex(ub) = startIndex
ElseIf length = maxLength Then
ub += 1
Redim Preserve maxIndex(1 To ub)
maxIndex(ub) = startIndex
End If
startIndex = i
length = 1
word = iw(i).word
End If
Next
If length > maxLength Then
maxLength = length
Erase maxIndex
Redim maxIndex(1 To 1)
maxIndex(1) = startIndex
ElseIf length = maxLength Then
ub += 1
Redim Preserve maxIndex(1 To ub)
maxIndex(ub) = startIndex
End If
Print Str(count); " words in the dictionary"
Print "The anagram set(s) with the greatest number of words (namely"; maxLength; ") is:"
Print
Dim iws(1 To maxLength) As IndexedWord '' array to hold each anagram set
For i As Integer = 1 To UBound(maxIndex)
For j As Integer = maxIndex(i) To maxIndex(i) + maxLength - 1
iws(j - maxIndex(i) + 1) = iw(j)
Next j
sortIndexedWord iws() '' sort anagram set before displaying it
For j As Integer = 1 To maxLength
Print w(iws(j).index); " ";
Next j
Print
Next i
Print
Print "Took ";
Print Using "#.###"; timer - t;
Print " seconds on i3 @ 2.13 GHz"
Print
Print "Press any key to quit"
Sleep

16
Task/Anagrams/Frink/anagrams.frink Normal file
View file

@ -0,0 +1,16 @@
d = new dict
for w = lines["http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"]
{
sorted = sort[charList[w]]
d.addToList[sorted, w]
}
most = sort[toArray[d], {|a,b| length[b@1] <=> length[a@1]}]
longest = length[most@0@1]
i = 0
while length[most@i@1] == longest
{
println[most@i@1]
i = i + 1
}

49
Task/Anagrams/FutureBasic/anagrams-1.basic Normal file
View file

@ -0,0 +1,49 @@
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)
for temp in dict
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

76
Task/Anagrams/FutureBasic/anagrams-2.basic Normal file
View file

@ -0,0 +1,76 @@
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 DoIt
CFArrayRef words
CFMutableArrayRef sortedWords, letters
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

53
Task/Anagrams/GAP/anagrams.gap Normal file
View file

@ -0,0 +1,53 @@
Anagrams := function(name)
local f, p, L, line, word, words, swords, res, cur, r;
words := [ ];
swords := [ ];
f := InputTextFile(name);
while true do
line := ReadLine(f);
if line = fail then
break;
else
word := Chomp(line);
Add(words, word);
Add(swords, SortedList(word));
fi;
od;
CloseStream(f);
p := SortingPerm(swords);
L := Permuted(words, p);
r := "";
cur := [ ];
res := [ ];
for word in L do
if SortedList(word) = r then
Add(cur, word);
else
if Length(cur) > 0 then
Add(res, cur);
fi;
r := SortedList(word);
cur := [ word ];
fi;
od;
if Length(cur) > 0 then
Add(res, cur);
fi;
return Filtered(res, v -> Length(v) > 1);
end;
ana := Anagrams("my/gap/unixdict.txt");;
# What is the longest anagram sequence ?
Maximum(List(ana, Length));
# 5
# Which are they ?
Filtered(ana, v -> Length(v) = 5);
# [ [ "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" ] ]

47
Task/Anagrams/Go/anagrams.go Normal file
View file

@ -0,0 +1,47 @@
package main
import (
"bytes"
"fmt"
"io/ioutil"
"net/http"
"sort"
)
func main() {
r, err := http.Get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
if err != nil {
fmt.Println(err)
return
}
b, err := ioutil.ReadAll(r.Body)
r.Body.Close()
if err != nil {
fmt.Println(err)
return
}
var ma int
var bs byteSlice
m := make(map[string][][]byte)
for _, word := range bytes.Fields(b) {
bs = append(bs[:0], byteSlice(word)...)
sort.Sort(bs)
k := string(bs)
a := append(m[k], word)
if len(a) > ma {
ma = len(a)
}
m[k] = a
}
for _, a := range m {
if len(a) == ma {
fmt.Printf("%s\n", a)
}
}
}
type byteSlice []byte
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] }

5
Task/Anagrams/Groovy/anagrams.groovy Normal file
View file

@ -0,0 +1,5 @@
def words = new URL('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt').text.readLines()
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')

10
Task/Anagrams/Haskell/anagrams-1.hs Normal file
View file

@ -0,0 +1,10 @@
import Data.List
groupon f x y = f x == f y
main = do
f <- readFile "./../Puzzels/Rosetta/unixdict.txt"
let words = lines f
wix = groupBy (groupon fst) . sort $ zip (map sort words) words
mxl = maximum $ map length wix
mapM_ (print . map snd) . filter ((==mxl).length) $ wix

7
Task/Anagrams/Haskell/anagrams-2.hs Normal file
View file

@ -0,0 +1,7 @@
*Main> main
["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"]

12
Task/Anagrams/Haskell/anagrams-3.hs Normal file
View file

@ -0,0 +1,12 @@
import Data.List (groupBy, maximumBy, sort)
import Data.Ord (comparing)
import Data.Function (on)
import Data.Text (pack)
main :: IO ()
main = do
f <- readFile "./unixdict.txt"
let ws = groupBy (on (==) fst) (sort (((,) =<< pack . sort) <$> lines f))
mapM_
(print . fmap snd)
(filter ((length (maximumBy (comparing length) ws) ==) . length) ws)

34
Task/Anagrams/Icon/anagrams.icon Normal file
View file

@ -0,0 +1,34 @@
procedure main(args)
every writeSet(!getLongestAnagramSets())
end
procedure getLongestAnagramSets()
wordSets := table()
longestWSet := 0
longSets := set()
every word := !&input do {
wChars := csort(word)
/wordSets[wChars] := set()
insert(wordSets[wChars], word)
if 1 < *wordSets[wChars} == longestWSet then
insert(longSets, wordSets[wChars])
if 1 < *wordSets[wChars} > longestWSet then {
longestWSet := *wordSets[wChars}
longSets := set([wordSets[wChars]])
}
}
return longSets
end
procedure writeSet(words)
every writes("\t"|!words," ")
write()
end
procedure csort(w)
every (s := "") ||:= (find(c := !cset(w),w),c)
return s
end

14
Task/Anagrams/J/anagrams-1.j Normal file
View file

@ -0,0 +1,14 @@
(#~ a: ~: {:"1) (]/.~ /:~&>) <;._2 ] 1!:1 <'unixdict.txt'
+-----+-----+-----+-----+-----+
|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 |
+-----+-----+-----+-----+-----+

1
Task/Anagrams/J/anagrams-2.j Normal file
View file

@ -0,0 +1 @@
<;._2 ] 1!:1 <'unixdict.txt'

1
Task/Anagrams/J/anagrams-3.j Normal file
View file

@ -0,0 +1 @@
(]/.~ /:~&>)

1
Task/Anagrams/J/anagrams-4.j Normal file
View file

@ -0,0 +1 @@
(#~ a: ~: {:"1)

30
Task/Anagrams/Java/anagrams-1.java Normal file
View file

@ -0,0 +1,30 @@
import java.net.*;
import java.io.*;
import java.util.*;
public class WordsOfEqChars {
public static void main(String[] args) throws IOException {
URL url = new URL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt");
InputStreamReader isr = new InputStreamReader(url.openStream());
BufferedReader reader = new BufferedReader(isr);
Map<String, Collection<String>> anagrams = new HashMap<String, Collection<String>>();
String word;
int count = 0;
while ((word = reader.readLine()) != null) {
char[] chars = word.toCharArray();
Arrays.sort(chars);
String key = new String(chars);
if (!anagrams.containsKey(key))
anagrams.put(key, new ArrayList<String>());
anagrams.get(key).add(word);
count = Math.max(count, anagrams.get(key).size());
}
reader.close();
for (Collection<String> ana : anagrams.values())
if (ana.size() >= count)
System.out.println(ana);
}
}

53
Task/Anagrams/Java/anagrams-2.java Normal file
View file

@ -0,0 +1,53 @@
import java.net.*;
import java.io.*;
import java.util.*;
import java.util.concurrent.*;
import java.util.function.*;
public interface Anagram {
public static <AUTOCLOSEABLE extends AutoCloseable, OUTPUT> Supplier<OUTPUT> tryWithResources(Callable<AUTOCLOSEABLE> callable, Function<AUTOCLOSEABLE, Supplier<OUTPUT>> function, Supplier<OUTPUT> defaultSupplier) {
return () -> {
try (AUTOCLOSEABLE autoCloseable = callable.call()) {
return function.apply(autoCloseable).get();
} catch (Throwable throwable) {
return defaultSupplier.get();
}
};
}
public static <INPUT, OUTPUT> Function<INPUT, OUTPUT> function(Supplier<OUTPUT> supplier) {
return i -> supplier.get();
}
public static void main(String... args) {
Map<String, Collection<String>> anagrams = new ConcurrentSkipListMap<>();
int count = tryWithResources(
() -> new BufferedReader(
new InputStreamReader(
new URL(
"http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"
).openStream()
)
),
reader -> () -> reader.lines()
.parallel()
.mapToInt(word -> {
char[] chars = word.toCharArray();
Arrays.parallelSort(chars);
String key = Arrays.toString(chars);
Collection<String> collection = anagrams.computeIfAbsent(
key, function(ArrayList::new)
);
collection.add(word);
return collection.size();
})
.max()
.orElse(0),
() -> 0
).get();
anagrams.values().stream()
.filter(ana -> ana.size() >= count)
.forEach(System.out::println)
;
}
}

23
Task/Anagrams/JavaScript/anagrams-1.js Normal file
View file

@ -0,0 +1,23 @@
var fs = require('fs');
var words = fs.readFileSync('unixdict.txt', 'UTF-8').split('\n');
var i, item, max = 0,
anagrams = {};
for (i = 0; i < words.length; i += 1) {
var key = words[i].split('').sort().join('');
if (!anagrams.hasOwnProperty(key)) {//check if property exists on current obj only
anagrams[key] = [];
}
var count = anagrams[key].push(words[i]); //push returns new array length
max = Math.max(count, max);
}
//note, this returns all arrays that match the maximum length
for (item in anagrams) {
if (anagrams.hasOwnProperty(item)) {//check if property exists on current obj only
if (anagrams[item].length === max) {
console.log(anagrams[item].join(' '));
}
}
}

22
Task/Anagrams/JavaScript/anagrams-2.js Normal file
View file

@ -0,0 +1,22 @@
var fs = require('fs');
var dictionary = fs.readFileSync('unixdict.txt', 'UTF-8').split('\n');
//group anagrams
var sortedDict = dictionary.reduce(function (acc, word) {
var sortedLetters = word.split('').sort().join('');
if (acc[sortedLetters] === undefined) { acc[sortedLetters] = []; }
acc[sortedLetters].push(word);
return acc;
}, {});
//sort list by frequency
var keysSortedByFrequency = Object.keys(sortedDict).sort(function (keyA, keyB) {
if (sortedDict[keyA].length < sortedDict[keyB].length) { return 1; }
if (sortedDict[keyA].length > sortedDict[keyB].length) { return -1; }
return 0;
});
//print first 10 anagrams by frequency
keysSortedByFrequency.slice(0, 10).forEach(function (key) {
console.log(sortedDict[key].join(' '));
});

168
Task/Anagrams/JavaScript/anagrams-3.js Normal file
View file

@ -0,0 +1,168 @@
(() => {
'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();
})();

11
Task/Anagrams/Jq/anagrams-1.jq Normal file
View file

@ -0,0 +1,11 @@
def anagrams:
(reduce .[] as $word (
{table: {}, max: 0}; # state
($word | explode | sort | implode) as $hash
| .table[$hash] += [ $word ]
| .max = ([ .max, ( .table[$hash] | length) ] | max ) ))
| .max as $max
| .table | .[] | select(length == $max) ;
# The task:
split("\n") | anagrams

7
Task/Anagrams/Jq/anagrams-2.jq Normal file
View file

@ -0,0 +1,7 @@
$ jq -M -s -c -R -f anagrams.jq unixdict.txt
["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"]

39
Task/Anagrams/Jsish/anagrams.jsish Normal file
View file

@ -0,0 +1,39 @@
/* Anagrams, in Jsish */
var datafile = 'unixdict.txt';
if (console.args[0] == '-more' && Interp.conf('maxArrayList') > 500000)
datafile = '/usr/share/dict/words';
var words = File.read(datafile).split('\n');
puts(words.length, 'words');
var i, item, max = 0, anagrams = {};
for (i = 0; i < words.length; i += 1) {
var key = words[i].split('').sort().join('');
if (!anagrams.hasOwnProperty(key)) {
anagrams[key] = [];
}
var count = anagrams[key].push(words[i]);
max = Math.max(count, max);
}
// display all arrays that match the maximum length
for (item in anagrams) {
if (anagrams.hasOwnProperty(item)) {
if (anagrams[item].length === max) {
puts(anagrams[item].join(' '));
}
}
}
/*
=!EXPECTSTART!=
25108 words
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
=!EXPECTEND!=
*/

16
Task/Anagrams/Julia/anagrams.julia Normal file
View file

@ -0,0 +1,16 @@
url = "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"
wordlist = open(readlines, download(url))
wsort(word::AbstractString) = join(sort(collect(word)))
function anagram(wordlist::Vector{<:AbstractString})
dict = Dict{String, Set{String}}()
for word in wordlist
sorted = wsort(word)
push!(get!(dict, sorted, Set{String}()), word)
end
wcnt = maximum(length, values(dict))
return collect(Iterators.filter((y) -> length(y) == wcnt, values(dict)))
end
println.(anagram(wordlist))

1
Task/Anagrams/K/anagrams.k Normal file
View file

@ -0,0 +1 @@
{x@&a=|/a:#:'x}{x g@&1<#:'g:={x@<x}'x}0::`unixdict.txt

26
Task/Anagrams/Kotlin/anagrams.kotlin Normal file
View file

@ -0,0 +1,26 @@
import java.io.BufferedReader
import java.io.InputStreamReader
import java.net.URL
import kotlin.math.max
fun main() {
val url = URL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
val isr = InputStreamReader(url.openStream())
val reader = BufferedReader(isr)
val anagrams = mutableMapOf<String, MutableList<String>>()
var count = 0
var word = reader.readLine()
while (word != null) {
val chars = word.toCharArray()
chars.sort()
val key = chars.joinToString("")
if (!anagrams.containsKey(key)) anagrams[key] = mutableListOf()
anagrams[key]?.add(word)
count = max(count, anagrams[key]?.size ?: 0)
word = reader.readLine()
}
reader.close()
anagrams.values
.filter { it.size == count }
.forEach { println(it) }
}

27
Task/Anagrams/Lasso/anagrams.lasso Normal file
View file

@ -0,0 +1,27 @@
local(
anagrams = map,
words = include_url('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt')->split('\n'),
key,
max = 0,
findings = array
)
with word in #words do {
#key = #word -> split('') -> sort& -> join('')
if(not(#anagrams >> #key)) => {
#anagrams -> insert(#key = array)
}
#anagrams -> find(#key) -> insert(#word)
}
with ana in #anagrams
let ana_size = #ana -> size
do {
if(#ana_size > #max) => {
#findings = array(#ana -> join(', '))
#max = #ana_size
else(#ana_size == #max)
#findings -> insert(#ana -> join(', '))
}
}
#findings -> join('<br />\n')

71
Task/Anagrams/Liberty-BASIC/anagrams.basic Normal file
View file

@ -0,0 +1,71 @@
' count the word list
open "unixdict.txt" for input as #1
while not(eof(#1))
line input #1,null$
numWords=numWords+1
wend
close #1
'import to an array appending sorted letter set
open "unixdict.txt" for input as #1
dim wordList$(numWords,3)
dim chrSort$(45)
wordNum=1
while wordNum<numWords
line input #1,actualWord$
wordList$(wordNum,1)=actualWord$
wordList$(wordNum,2)=sorted$(actualWord$)
wordNum=wordNum+1
wend
'sort on letter set
sort wordList$(),1,numWords,2
'count and store number of anagrams found
wordNum=1
startPosition=wordNum
numAnagrams=0
currentChrSet$=wordList$(wordNum,2)
while wordNum < numWords
while currentChrSet$=wordList$(wordNum,2)
numAnagrams=numAnagrams+1
wordNum=wordNum+1
wend
for n= startPosition to startPosition+numAnagrams
wordList$(n,3)=right$("0000"+str$(numAnagrams),4)+wordList$(n,2)
next
startPosition=wordNum
numAnagrams=0
currentChrSet$=wordList$(wordNum,2)
wend
'sort on number of anagrams+letter set
sort wordList$(),numWords,1,3
'display the top anagram sets found
wordNum=1
while wordNum<150
currentChrSet$=wordList$(wordNum,2)
print "Anagram set";
while currentChrSet$=wordList$(wordNum,2)
print " : ";wordList$(wordNum,1);
wordNum=wordNum+1
wend
print
currentChrSet$=wordList$(wordNum,2)
wend
close #1
end
function sorted$(w$)
nchr=len(w$)
for chr = 1 to nchr
chrSort$(chr)=mid$(w$,chr,1)
next
sort chrSort$(),1,nchr
sorted$=""
for chr = 1 to nchr
sorted$=sorted$+chrSort$(chr)
next
end function

39
Task/Anagrams/LiveCode/anagrams.livecode Normal file
View file

@ -0,0 +1,39 @@
on mouseUp
put mostCommonAnagrams(url "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
end mouseUp
function mostCommonAnagrams X
put 0 into maxCount
repeat for each word W in X
get sortChars(W)
put W & comma after A[it]
add 1 to C[it]
if C[it] >= maxCount then
if C[it] > maxCount then
put C[it] into maxCount
put char 1 to -2 of A[it] into winnerList
else
put cr & char 1 to -2 of A[it] after winnerList
end if
end if
end repeat
return winnerList
end mostCommonAnagrams
function sortChars X
get charsToItems(X)
sort items of it
return itemsToChars(it)
end sortChars
function charsToItems X
repeat for each char C in X
put C & comma after R
end repeat
return char 1 to -2 of R
end charsToItems
function itemsToChars X
replace comma with empty in X
return X
end itemsToChars

24
Task/Anagrams/Lua/anagrams.lua Normal file
View file

@ -0,0 +1,24 @@
function sort(word)
local bytes = {word:byte(1, -1)}
table.sort(bytes)
return string.char(table.unpack(bytes))
end
-- Read in and organize the words.
-- word_sets[<alphabetized_letter_list>] = {<words_with_those_letters>}
local word_sets = {}
local max_size = 0
for word in io.lines('unixdict.txt') do
local key = sort(word)
if word_sets[key] == nil then word_sets[key] = {} end
table.insert(word_sets[key], word)
max_size = math.max(max_size, #word_sets[key])
end
-- Print out the answer sets.
for _, word_set in pairs(word_sets) do
if #word_set == max_size then
for _, word in pairs(word_set) do io.write(word .. ' ') end
print('') -- Finish with a newline.
end
end

46
Task/Anagrams/M4/anagrams.m4 Normal file
View file

@ -0,0 +1,46 @@
divert(-1)
changequote(`[',`]')
define([for],
[ifelse($#,0,[[$0]],
[ifelse(eval($2<=$3),1,
[pushdef([$1],$2)$4[]popdef([$1])$0([$1],incr($2),$3,[$4])])])])
define([_bar],include(t.txt))
define([eachlineA],
[ifelse(eval($2>0),1,
[$3(substr([$1],0,$2))[]eachline(substr([$1],incr($2)),[$3])])])
define([eachline],[eachlineA([$1],index($1,[
]),[$2])])
define([removefirst],
[substr([$1],0,$2)[]substr([$1],incr($2))])
define([checkfirst],
[ifelse(eval(index([$2],substr([$1],0,1))<0),1,
0,
[ispermutation(substr([$1],1),
removefirst([$2],index([$2],substr([$1],0,1))))])])
define([ispermutation],
[ifelse([$1],[$2],1,
eval(len([$1])!=len([$2])),1,0,
len([$1]),0,0,
[checkfirst([$1],[$2])])])
define([_set],[define($1<$2>,$3)])
define([_get],[defn([$1<$2>])])
define([_max],1)
define([_n],0)
define([matchj],
[_set([count],$2,incr(_get([count],$2)))[]ifelse(eval(_get([count],$2)>_max),
1,[define([_max],incr(_max))])[]_set([list],$2,[_get([list],$2) $1])])
define([checkwordj],
[ifelse(ispermutation([$1],_get([word],$2)),1,[matchj([$1],$2)],
[addwordj([$1],incr($2))])])
define([_append],
[_set([word],_n,[$1])[]_set([count],_n,1)[]_set([list],_n,
[$1 ])[]define([_n],incr(_n))])
define([addwordj],
[ifelse($2,_n,[_append([$1])],[checkwordj([$1],$2)])])
define([addword],
[addwordj([$1],0)])
divert
eachline(_bar,[addword])
_max
for([x],1,_n,[ifelse(_get([count],x),_max,[_get([list],x)
])])

35
Task/Anagrams/MUMPS/anagrams.mumps Normal file
View file

@ -0,0 +1,35 @@
Anagrams New ii,file,longest,most,sorted,word
Set file="unixdict.txt"
Open file:"r" Use file
For Quit:$ZEOF DO
. New char,sort
. Read word Quit:word=""
. For ii=1:1:$Length(word) Do
. . Set char=$ASCII(word,ii)
. . If char>64,char<91 Set char=char+32
. . Set sort(char)=$Get(sort(char))+1
. . Quit
. Set (sorted,char)="" For Set char=$Order(sort(char)) Quit:char="" Do
. . For ii=1:1:sort(char) Set sorted=sorted_$Char(char)
. . Quit
. Set table(sorted,word)=1
. Quit
Close file
Set sorted="" For Set sorted=$Order(table(sorted)) Quit:sorted="" Do
. Set ii=0,word="" For Set word=$Order(table(sorted,word)) Quit:word="" Set ii=ii+1
. Quit:ii<2
. Set most(ii,sorted)=1
. Quit
Write !,"The anagrams with the most variations:"
Set ii=$Order(most(""),-1)
Set sorted="" For Set sorted=$Order(most(ii,sorted)) Quit:sorted="" Do
. Write ! Set word="" For Set word=$Order(table(sorted,word)) Quit:word="" Write " ",word
. Quit
Write !,"The longest anagrams:"
Set ii=$Order(longest(""),-1)
Set sorted="" For Set sorted=$Order(longest(ii,sorted)) Quit:sorted="" Do
. Write ! Set word="" For Set word=$Order(table(sorted,word)) Quit:word="" Write " ",word
. Quit
Quit
Do Anagrams

7
Task/Anagrams/Maple/anagrams-1.maple Normal file
View file

@ -0,0 +1,7 @@
words := HTTP:-Get( "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" )[2]: # ignore errors
use StringTools, ListTools in
T := Classify( Sort, map( Trim, Split( words ) ) )
end use:
L := convert( T, 'list' ):
m := max( map( nops, L ) ); # what is the largest set?
A := select( s -> evalb( nops( s ) = m ), L ); # get the maximal sets of anagrams

4
Task/Anagrams/Maple/anagrams-2.maple Normal file
View file

@ -0,0 +1,4 @@
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"}];

6
Task/Anagrams/Mathematica/anagrams-1.math Normal file
View file

@ -0,0 +1,6 @@
list=Import["http://wiki.puzzlers.org/pub/wordlists/unixdict.txt","Lines"];
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&]

1
Task/Anagrams/Mathematica/anagrams-2.math Normal file
View file

@ -0,0 +1 @@
{{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}}

3
Task/Anagrams/Mathematica/anagrams-3.math Normal file
View file

@ -0,0 +1,3 @@
splits = Gather[list, Sort[Characters[#]] == Sort[Characters[#2]] &];
maxlen = Max[Length /@ splits];
Select[splits, Length[#] == maxlen &]

2
Task/Anagrams/Mathematica/anagrams-4.math Normal file
View file

@ -0,0 +1,2 @@
anagramGroups = GatherBy[SortBy[GatherBy[list,Sort[Characters[#]] &],Length],Length];
anagramGroups[[-1]]

2
Task/Anagrams/Mathematica/anagrams-5.math Normal file
View file

@ -0,0 +1,2 @@
list=Import["http://wiki.puzzlers.org/pub/wordlists/unixdict.txt","Lines"];
MaximalBy[GatherBy[list, Sort@*Characters], Length]

39
Task/Anagrams/Maxima/anagrams.maxima Normal file
View file

@ -0,0 +1,39 @@
read_file(name) := block([file, s, L], file: openr(name), L: [],
while stringp(s: readline(file)) do L: cons(s, L), close(file), L)$
u: read_file("C:/my/mxm/unixdict.txt")$
v: map(lambda([s], [ssort(s), s]), u)$
w: sort(v, lambda([x, y], orderlessp(x[1], y[1])))$
ana(L) := block([m, n, p, r, u, v, w],
L: endcons(["", ""], L),
n: length(L),
r: "",
m: 0,
v: [ ],
w: [ ],
for i from 1 thru n do (
u: L[i],
if r = u[1] then (
w: cons(u[2], w)
) else (
p: length(w),
if p >= m then (
if p > m then (m: p, v: []),
v: cons(w, v)
),
w: [u[2]],
r: u[1]
)
),
v)$
ana(w);
/* [["evil", "levi", "live", "veil", "vile"],
["elan", "lane", "lean", "lena", "neal"],
["alger", "glare", "lager", "large", "regal"],
["angel", "angle", "galen", "glean", "lange"],
["caret", "carte", "cater", "crate", "trace"],
["abel", "able", "bale", "bela", "elba"]] */

60
Task/Anagrams/NetRexx/anagrams-1.netrexx Normal file
View file

@ -0,0 +1,60 @@
/* NetRexx */
options replace format comments java crossref symbols nobinary
class RAnagramsV01 public
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public signals MalformedURLException, IOException
parse arg localFile .
isr = Reader
if localFile = '' then do
durl = URL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
dictFrom = durl.toString()
isr = InputStreamReader(durl.openStream())
end
else do
dictFrom = localFile
isr = FileReader(localFile)
end
say 'Searching' dictFrom 'for anagrams'
dictionaryReader = BufferedReader(isr)
anagrams = Map HashMap()
aWord = String
count = 0
loop label w_ forever
aWord = dictionaryReader.readLine()
if aWord = null then leave w_
chars = aWord.toCharArray()
Arrays.sort(chars)
key = String(chars)
if (\anagrams.containsKey(key)) then do
anagrams.put(key, ArrayList())
end
(ArrayList anagrams.get(key)).add(Object aWord)
count = Math.max(count, (ArrayList anagrams.get(key)).size())
end w_
dictionaryReader.close
ani = anagrams.values().iterator()
loop label a_ while ani.hasNext()
ana = ani.next()
if (ArrayList ana).size() >= count then do
say ana
end
end a_
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method main(args = String[]) public static
arg = Rexx(args)
Do
ra = RAnagramsV01()
ra.runSample(arg)
Catch ex = Exception
ex.printStackTrace()
End
return

57
Task/Anagrams/NetRexx/anagrams-2.netrexx Normal file
View file

@ -0,0 +1,57 @@
/* NetRexx */
options replace format comments java crossref symbols nobinary
runSample(arg)
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method findMostAnagrams(arg) public static signals MalformedURLException, IOException
parse arg localFile .
isr = Reader
if localFile = '' then do
durl = URL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
dictFrom = durl.toString()
isr = InputStreamReader(durl.openStream())
end
else do
dictFrom = localFile
isr = FileReader(localFile)
end
say 'Searching' dictFrom 'for anagrams'
dictionaryReader = BufferedReader(isr)
anagrams = 0
maxWords = 0
loop label w_ forever
aWord = dictionaryReader.readLine()
if aWord = null then leave w_
chars = aWord.toCharArray()
Arrays.sort(chars)
key = Rexx(chars)
parse anagrams[key] count aWords
aWords = (aWords aWord).space()
maxWords = maxWords.max(aWords.words())
anagrams[key] = aWords.words() aWords
end w_
dictionaryReader.close
loop key over anagrams
parse anagrams[key] count aWords
if count >= maxWords then
say aWords
else
anagrams[key] = null -- remove unwanted elements from the indexed string
end key
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public static
Do
findMostAnagrams(arg)
Catch ex = Exception
ex.printStackTrace()
End
Return

27
Task/Anagrams/NewLISP/anagrams.l Normal file
View file

@ -0,0 +1,27 @@
;;; 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)))

Some files were not shown because too many files have changed in this diff Show more