1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
#! /usr/bin/env gforth
\ Challenge 094
\
\ TASK #1 � Group Anagrams
\ Submitted by: Mohammad S Anwar
\ You are given an array of strings @S.
\
\ Write a script to group Anagrams together in any random order.
\
\ An Anagram is a word or phrase formed by rearranging the letters of a
\ different word or phrase, typically using all the original letters exactly
\ once.
\
\ Example 1:
\ Input: ("opt", "bat", "saw", "tab", "pot", "top", "was")
\ Output: [ ("bat", "tab"),
\ ("saw", "was"),
\ ("top", "pot", "opt") ]
\ Example 2:
\ Input: ("x")
\ Output: [ ("x") ]
\ -----------------------------------------------------------------------------
\ counted strings
\ compare two counted strings
: cstr= ( c-addr1 c-addr2 -- f )
>R COUNT R> COUNT STR=
;
\ copy string as counted string to pad
: str>pad ( addr len -- )
DUP PAD C!
PAD 1+ SWAP CMOVE
;
\ allot string as counted string
: cstr, ( addr len -- )
DUP C, >R \ store length
HERE R@ CMOVE \ copy string
R> ALLOT \ advance HERE
ALIGN
;
\ -----------------------------------------------------------------------------
\ Linked list of strings
\ create a new string list
: new_strlist ( -- list-addr )
HERE 0 , 0 ,
;
: strlist.head ( list-addr -- head-addr )
;
: strlist.tail ( list-addr -- tail-addr )
1 CELLS +
;
\ create a new node for a string list
: new_strnode ( addr len -- node-addr )
HERE >R ( R:node-addr )
0 , \ store next pointer
cstr, \ store string
R> ( node-addr )
;
: strnode.next ( node-addr -- next-addr )
;
: strnode.cstring ( node-addr -- cstring-addr )
1 CELLS +
;
\ push a string to the end of the list
: strlist.push { addr len list-addr -- }
addr len new_strnode ( node-addr )
list-addr strlist.head @ 0= IF \ list is empty
DUP list-addr strlist.head !
list-addr strlist.tail !
ELSE
DUP
list-addr strlist.tail @ ( new-node last-node )
strnode.next ! \ store node in next of last node
list-addr strlist.tail ! \ point tail to node
THEN
;
: strlist.print-sep ( first -- first )
DUP IF
DROP 0
ELSE
." , "
THEN
;
: strlist.print ( list-addr -- )
1 SWAP ( first list-addr )
'(' EMIT
strlist.head @ ( first node-addr )
BEGIN DUP 0<> WHILE \ while pointer not null
SWAP strlist.print-sep SWAP
'"' EMIT
DUP strnode.cstring COUNT TYPE
'"' EMIT
strnode.next @
REPEAT
')' EMIT
2DROP
;
\ -----------------------------------------------------------------------------
\ map of string to linked list of strings
\ create new map
: new_map ( -- map-addr )
HERE 0 , 0 ,
;
: map.head ( map-addr -- head-addr )
;
: map.tail ( map-addr -- tail-addr )
1 CELLS +
;
\ create a new node for a map
: new_mapnode ( addr len -- node-addr )
HERE >R ( R:node-addr )
0 , \ store next pointer
new_strlist DROP \ store list of string values
cstr, \ store key string
R> ( node-addr )
;
: mapnode.next ( node-addr -- next-addr )
;
: mapnode.strlist ( node-addr -- strlist-addr )
1 CELLS +
;
: mapnode.key ( node-addr -- cstring-addr )
3 CELLS +
;
: map.add_first ( node-addr map-addr -- )
2DUP
map.head !
map.tail !
;
: map.append { node-addr map-addr -- }
node-addr map-addr map.tail @ mapnode.next ! \ point next of last to node
node-addr map-addr map.tail ! \ point tail to node
;
: map.find_node ( map-addr -- node-addr|0 ) \ find node with key in PAD
map.head @ ( nope-addr )
BEGIN DUP 0<> WHILE
DUP mapnode.key PAD cstr= IF \ same key?
EXIT ( node-addr ) \ of found key
THEN
mapnode.next @ \ point to next
REPEAT
( 0 ) \ entry not found
;
\ add/search a key to a map, return strlist
: map.add_key { addr len map-addr -- node-strlist }
addr len str>pad \ save key in PAD
map-addr map.head @ 0= IF \ map is empty
PAD COUNT new_mapnode ( node-addr )
DUP map-addr map.add_first \ add first entry
mapnode.strlist ( node-strlist )
ELSE
map-addr map.find_node ( node-addr|0 )
?DUP IF
mapnode.strlist ( node-strlist )
ELSE
PAD COUNT new_mapnode ( node-addr )
DUP map-addr map.append \ append node
mapnode.strlist ( node-strlist )
THEN
THEN
;
: map.print-sep ( first -- first )
DUP IF
DROP 0
ELSE
',' EMIT CR 2 SPACES
THEN
;
: map.print ( map-addr -- )
1 SWAP ( first map-addr )
." [ "
map.head @ ( first node-addr )
BEGIN DUP 0<> WHILE
SWAP map.print-sep SWAP ( node-addr )
DUP mapnode.strlist strlist.print \ print values
mapnode.next @ \ move to next
REPEAT
2DROP
." ]" CR
;
\ -----------------------------------------------------------------------------
\ sort a string
\ selection sort
: str-sort { addr len }
\ outer loop
len 1- 0 ?DO \ i1: 0..len-1
I ( min-idx=i1 )
\ inner loop: search minimum value
len I 1+ ?DO \ i2: i1+1..len
I addr + C@ ( min-idx c[i2] )
OVER addr + C@ ( min-idx c[i2] c[min-idx])
< IF
DROP I ( min-idx=i2 )
THEN
LOOP
\ swap values
I addr + C@ ( min-idx c[i1] )
OVER addr + C@ ( min-idx c[i1] c[min-idx] )
I addr + C! ( min-idx c[i] )
SWAP addr + C! ( )
LOOP
;
\ -----------------------------------------------------------------------------
\ main program
\ read strings from args, built map
\ print map
: build-map { map -- }
BEGIN NEXT-ARG ?DUP WHILE \ read each argument
2DUP str>pad \ copy string to PAD
PAD COUNT str-sort \ build key (sorted chars of string) in PAD
( arg-addr arg-size )
PAD COUNT map map.add_key ( arg-addr arg-size node-strlist )
strlist.push \ add string to values list
REPEAT DROP
;
new_map value map
map build-map
map map.print
bye
|
