132 lines
5.5 KiB
Text
132 lines
5.5 KiB
Text
\
|
|
\ 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
|
|
;
|