-
Notifications
You must be signed in to change notification settings - Fork 1
/
sort.4th
211 lines (156 loc) · 8.46 KB
/
sort.4th
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
( S" lib/ext/case.f" INCLUDED )
1 VALUE temp
VARIABLE temp2 0 temp2 !
VARIABLE on_this_index
VARIABLE on_index_max
VARIABLE min
VARIABLE max
VARIABLE input_file 0 ,
VARIABLE indexes_file 0 ,
VARIABLE tempnumber
VARIABLE tempindex
VARIABLE counter2
VARIABLE delta
VARIABLE sec_delta
VARIABLE buf_cnt
VARIABLE n_zero
VARIABLE n_one
VARIABLE n_two
VARIABLE n_three
VARIABLE n_four
VARIABLE n_another
0 n_zero ! 0 n_one ! 0 n_two !
0 VALUE fid
32 ALLOCATE DROP CONSTANT buf
128 ALLOCATE DROP CONSTANT stack_buf
VARIABLE counter
VARIABLE counter1
VARIABLE 32cnt
STARTLOG
: +buf CELL buf_cnt +! ;
: -buf CELL NEGATE buf_cnt +! ;
: buf! stack_buf buf_cnt @ + ! +buf ;
: buf@ -buf stack_buf buf_cnt @ + @ ;
: minn min ! BEGIN DUP min @ < IF min @ >R min ! THEN -1 counter2 +! counter2 @ 0= UNTIL ;
: depth. ." Depth:" DEPTH . ;
: 32cnt- 32cnt @ 1- DUP 32cnt ! ;
: temp+ fid CELL+ 1+! ;
: counter- counter @ 1- counter ! counter @ ;
: cut-entry-spaces 32 32cnt ! BEGIN DUP C@ BL <> IF 1 32cnt ! ELSE 1+ temp+ THEN 32cnt- 0= UNTIL ;
: bl_word ( addr -- addr u ) cut-entry-spaces 32 32cnt !
BEGIN DUP C@ BL = IF 1 32cnt ! ELSE temp+ THEN 1+ 32cnt- 0= UNTIL DROP ;
: get_number ( file_id_adr -- number )
buf 32 fid @ READ-FILE DROP DROP ( ." IORr:" . DROP CR buf 32 TYPE CR )
buf bl_word fid CELL+ @ temp2 +!
buf fid CELL+ @ EVALUATE ( DUP . ) 1 fid CELL+ !
temp2 @ 0 fid @ REPOSITION-FILE DROP ;
S" input.txt" R/O OPEN-FILE DROP input_file !
S" indexes.txt" R/W CREATE-FILE DROP indexes_file !
: fill_by_zero 0 0 indexes_file @ REPOSITION-FILE DROP
BEGIN 0 0 (D.) DROP 32 indexes_file @ WRITE-FILE DROP counter- 0= UNTIL ;
input_file TO fid get_number DUP counter1 ! counter ! counter @ . .( numbers in file.) CR
get_number DUP min ! max !
counter1 @ 2* counter !
.( filling )
fill_by_zero
CR .( filled ) CR
counter1 @ 1- counter !
: (min) >R R@ min @ > IF R> buf! ELSE min @ buf! R> min ! THEN ;
: (min-max) >R R@ min @ < IF R@ min ! THEN R@ max @ > IF R@ max ! THEN R> ;
: min_max BEGIN get_number (min-max) DROP counter- 0= UNTIL ;
: min-max BEGIN get_number (min-max) DROP counter- 0= UNTIL ;
min_max
min @ .( Min:) . max @ .( Max:) .
max @ min @ - counter1 @ / 1+ DUP .( Delta:) . delta !
0. fid @ REPOSITION-FILE DROP
1 fid CELL+ ! 0 temp2 !
get_number counter !
: get_on_index
32 * S>D fid @ REPOSITION-FILE DROP buf 32 fid @ READ-FILE DROP DROP ( ." Buffer:" buf 32 TYPE depth. ) buf bl_word buf fid CELL+ @ EVALUATE 1 fid CELL+ ! ( DUP ." Eval:" . ) ;
: indexes
BEGIN input_file TO fid get_number tempnumber ! tempnumber @ min @ - delta @ / tempindex !
tempindex @ indexes_file TO fid get_on_index 1+ on_this_index ! on_this_index @ on_index_max @ MAX on_index_max !
tempindex @ 32 * S>D fid @ REPOSITION-FILE DROP
on_this_index @ S>D (D.) fid @ WRITE-FILE DROP
on_this_index @ counter1 @ * tempindex @ + 32 * S>D fid @ REPOSITION-FILE DROP
tempnumber @ S>D (D.) fid @ WRITE-FILE DROP
counter- 0= UNTIL ;
CR
indexes
: get_nth_number 32 * tempindex @ + S>D fid @ REPOSITION-FILE DROP
get_number
;
: on_one CR ." one " counter1 @ get_nth_number . DROP
;
: range_two 2DUP < IF SWAP THEN ;
: on_two CR ." two "
counter1 @ get_nth_number
counter1 @ 2* get_nth_number
range_two . . DROP ;
: on_three CR ." three "
counter1 @ get_nth_number
counter1 @ 2* get_nth_number
counter1 @ 3 * get_nth_number
min ! (min) (min) buf@ buf@ range_two min @ . . . DROP ;
: on_four CR ." four "
counter1 @ get_nth_number
counter1 @ 2* get_nth_number
counter1 @ 3 * get_nth_number
counter1 @ 4 * get_nth_number
min ! (min) (min) (min) min @ . buf@ buf@ buf@ min ! (min) (min) buf@ buf@ range_two min @ . . . DROP ;
on_index_max 1+!
0 tempindex !
counter1 @ counter !
indexes_file TO fid
on_index_max @ 16 * ALLOCATE DROP CONSTANT secondary_buf
: gather2 0 >R BEGIN secondary_buf on_index_max @ CELL * + R@ CELL * + @
DUP 0 = IF DROP ELSE
DUP 1 = IF DROP on_index_max @ 2* CELL * R@ CELL * + secondary_buf + @ . ELSE
DUP 2 = IF DROP on_index_max @ 2* CELL * R@ CELL * + secondary_buf + @
on_index_max @ 3 * CELL * R@ CELL * + secondary_buf + @
range_two . . ELSE
DUP 3 = IF ." sec_three "
DROP on_index_max @ 2* CELL * R@ CELL * + secondary_buf + @
on_index_max @ 3 * CELL * R@ CELL * + secondary_buf + @
on_index_max @ 4 * CELL * R@ CELL * + secondary_buf + @
min ! (min) (min) buf@ buf@ range_two min @ . . . ELSE
DUP 4 = IF ." sec_four " DROP
on_index_max @ 2* CELL * R@ CELL * + secondary_buf + @
on_index_max @ 3 * CELL * R@ CELL * + secondary_buf + @
on_index_max @ 4 * CELL * R@ CELL * + secondary_buf + @
on_index_max @ 5 * CELL * R@ CELL * + secondary_buf + @
min ! (min) (min) (min) min @ . buf@ buf@ buf@ min ! (min) (min) buf@ buf@ range_two min @ . . .
ELSE ." sec_more " DROP THEN THEN THEN THEN THEN
R> 1+ >R R@ counter2 @ = UNTIL RDROP
;
: secondary_indexes ( находим индекс для числа ) counter2 @ >R
BEGIN secondary_buf R@ CELL * + @ DUP min @ - sec_delta @ / >R
( инкрементируем индекс ) ( индесы лежат в сeкондарибуф начиная с ониндексмакс*селлс )
secondary_buf on_index_max @ CELL * + R> CELL * + DUP DUP 1+! @
( получбуфили значение индекса, умножаем его на ониндексмакс, на селл и прибавляем к началу индексов ) on_index_max @ * CELL * + ! ( а теперь надо записать число по этому адресу)
R> 1- >R R@ 0= UNTIL RDROP
;
: min_and_max counter2 @ >R secondary_buf CELL+ @ DUP min ! max !
BEGIN secondary_buf R@ CELL * + @ (min-max) DROP R> 1- >R R@ 0= UNTIL RDROP
( min @ . max @ . ." -- " ) max @ min @ - counter2 @ / 1+ sec_delta !
( нашли минимальное и максимальное, вычислили дельту )
secondary_indexes gather2
;
: on_another CR ." another " counter2 ! counter2 @ DUP >R >R ( counter2 - количество чисел во вторичном массиве )
BEGIN R@ counter1 @ * get_nth_number R@ CELL * secondary_buf + ! R> 1- >R R@ 0= UNTIL RDROP ( заполнили вторичный массив )
min_and_max RDROP
( BEGIN R@ CELL * secondary_buf + @ . R> 1- >R R@ 0= UNTIL RDROP ) ;
: gathering BEGIN tempindex @ S>D fid @ REPOSITION-FILE DROP get_number
DUP 0 = IF ( CR ." zero " ) n_zero 1+! DROP ELSE
DUP 1 = IF on_one n_one 1+! ELSE
DUP 2 = IF on_two n_two 1+! ELSE
DUP 3 = IF on_three n_three 1+! ELSE
DUP 4 = IF on_four n_four 1+! ELSE secondary_buf on_index_max @ 16 * 0 FILL
on_another n_another 1+! THEN THEN THEN THEN THEN
32 tempindex +!
counter- 0= UNTIL ;
0. fid @ REPOSITION-FILE DROP
max @ min @ max ! min !
gathering
on_index_max @ 1- CR
.( max in index:) . n_zero @ .( Zeroes:) . n_one @ .( Ones:) . n_two @ .( Twos:) . n_three @ .( Threes:) . n_four .( Fours:) @ . n_another @ .( More_than_four:) . CR CR