«Нелинейная» demo реализация сортировки естественным слиянием (Natural Merge Sort) на Visual FoxPro
Дан файловый источник Src (подразумевается достаточно большой DBF файл, который надо упорядочить по ключу (индексируемому полю) во внешний файл Buf1 или Buf2 , содержащих массив структур: индексируемое поле и номер его записи в Src . Операция Split определения упорядоченных подпследовательностей (УПП) в Src должна выполняться лишь однажды (в один проход) на Src , память под информацию об УПП если и отводиться то фиксированным количеством переменных, не зависящих от общего количества сортируемых ключей. Для удобства demo реализации алгоритма мы выбрали VFP , хотя конечный вариант будет написан на C++ . Вместо файлов взяты массивы памяти со случайным исходным набором чисел. Алгоритм сортировки также представлен следующим рисунком:
Заметим, что если отсутствует 13-я УПП в Src , то 3-я УПП в первом Buf2 , просто копируется во 2-ю УПП второго Buf1 .
А вот непосредственно код VFP, готовый для непосредственного выполнения:
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.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
&& Demo «Non Lineal» Natural Merge Sort by Emery Emerald (C) 2009
CLEAR
SET TALK OFF
SET SAFETY OFF
CLOSE ALL
SET TEXTMERGE ON TO sort.txt NOSHOW
RAND( 7777777 )
KeyLen = 7
Nmax = 100000
\\Nmax = <<Nmax>>
IF Nmax < 1
MESSAGEBOX("Nmax < 1!")
QUIT
ENDIF
DIMENSION Src[Nmax], Buf1[Nmax], Buf2[Nmax], Poses[ 32 ], Lens[ 32 ]
FOR i = 1 TO Nmax
Src[i] = INT( 10 ^(KeyLen+ 1 )*RAND())% 10 ^KeyLen
ENDFOR
*!* FOR i = 1 TO 32
*!* Poses[i] = 0
*!* Lens[i] = 0
*!* ENDFOR
*!* FOR i = 1 TO Nmax
*!* Buf1[i] = 0
*!* Buf2[i] = 0
*!* ENDFOR
i = 1
j = 1
NextPos = 1
OldNextPos = 0
Pos = 0
OldPos = 0
Len = 0
OldLen = 0
Sgn = 0
OldSgn = 0
LastSrcSgn = 0
OutPos = 1
IsEnd = .T.
&& Четные (парные) слияния
DO WHILE .T.
IF NOT Split(@NextPos, @Len, @Sgn, @Src, @IsEnd)
MESSAGEBOX("Error Split!")
EXIT
ENDIF
IF(IsEnd)
EXIT
ENDIF
LastSrcSgn = Sgn
Pos = IIF(Sgn == 1 , NextPos - Len, NextPos - 1 )
IF(i% 2 == 0 )
FOR j = 1 TO INT(LOG(i)/LOG( 2 ))
IF(i% 2 ^j == 0 )
OutPos = IIF(i == 2 ^j, 1 , OutPos)
In = IIF(j == 1 , "Src", IIF(j% 2 == 0 , "Buf1", "Buf2"))
Out = IIF(j% 2 == 0 , "Buf2", "Buf1")
Pos = IIF(j > 1 , OldPos, Pos)
Len = IIF(j > 1 , OldLen, Len)
Sgn = IIF(j > 1 , 1 , Sgn)
OldSgn = IIF(j > 1 , 1 , OldSgn)
OutPos = IIF(j > 1 , Pos, OutPos)
OldOutPos = OutPos
IF NOT Merge(Pos, Len, Sgn, Poses[j], Lens[j], OldSgn, @OutPos, @&Out, @&In, @&In)
MESSAGEBOX("Error Merge!")
QUIT
ENDIF
OldPos = Poses[j+ 1 ]
OldLen = Lens[j+ 1 ]
OldSgn = Sgn
Poses[j+ 1 ] = OldOutPos
Lens[j+ 1 ] = Len + Lens[j]
Sgn = 1
ENDIF
ENDFOR
ELSE
Poses[ 1 ] = Pos
Lens[ 1 ] = Len
OldSgn = Sgn
ENDIF
i = i + 1
ENDDO
K = i - 1
Q = j - 1
Out = IIF(K == 0 , "Src", IIF(j% 2 == 0 , "Buf1", "Buf2"))
&& Нечетные (непарные) слияния
IF K <> 2 ^Q
&& Существует как минимум два числа q1 и q2, т.ч. K = 2 ^q1 + 2 ^q2
&& Находим первое из них (наименьшее)
q1 = 0
FOR j = 0 TO 31
IF INT(K/ 2 ^j)% 2 == 1
q1 = j
EXIT
ENDIF
ENDFOR
IsQ1 = q1 > 0
q2 = 0
IsExit = .F.
LastPos = 0
LastLen = 0
DO WHILE .T.
&& Находим второе из них
FOR j = IIF(IsQ1, q1+ 1 , MAX(q1, 1 )) TO 31
P = INT(K/ 2 ^j)
IF P% 2 == 1
q2 = j
EXIT
ENDIF
IF P < 1
IsExit = .T.
EXIT
ENDIF
ENDFOR
IF IsExit
EXIT
ENDIF
IsQ1 = .F.
In1 = IIF(q1 == 0 , "Src", IIF(q1% 2 == 0 , "Buf2", "Buf1"))
In2 = IIF(q2% 2 == 0 , "Buf2", "Buf1")
Out = IIF(q2% 2 == 0 , "Buf1", "Buf2")
Sgn = IIF(q1 > 0 , 1 , LastSrcSgn)
&& Проверяем четность q1 и q2
IF (q1 > 0 ) AND ((q1% 2 == 0 AND q2% 2 == 1 ) OR (q1% 2 == 1 AND q2% 2 == 0 ))
In = IIF(q1 == 0 , "Src", IIF(q1% 2 == 0 , "Buf2", "Buf1"))
Out = IIF(q2% 2 == 0 , "Buf2", "Buf1")
&& Просто копируем УПП q1 в УПП q2
Pos = Poses[q1+ 1 ]
FOR j = Pos TO Pos + Lens[q1+ 1 ] - 1
Elem = &In[j]
&Out[j] = Elem
ENDFOR
In1 = Out
In2 = Out
Out = IIF(q2% 2 == 0 , "Buf1", "Buf2")
ENDIF
OutPos = Poses[q2+ 1 ]
LastPos = IIF(LastPos == 0 , Poses[q1+ 1 ], LastPos)
LastLen = IIF(LastLen == 0 , Lens[q1+ 1 ], LastLen)
&& Объединяем УПП q1 и q2
IF NOT Merge(LastPos, LastLen, Sgn, Poses[q2+ 1 ], Lens[q2+ 1 ], 1 , @OutPos, @&Out, @&In1, @&In2)
MESSAGEBOX("Error Merge!")
QUIT
ENDIF
LastPos = Poses[q2+ 1 ]
LastLen = Lens[q2+ 1 ] + LastLen
q1 = q2 + 1
ENDDO
Q = Q + 1
ENDIF
\Количество УПП = <<IIF(K == 0 , 1 , K)>>
\
FOR i = 1 TO Nmax
Elem = &Out[i]
\<<PADL(ALLTRIM(STR(Elem)), KeyLen, " ")>>
ENDFOR
\
\Количество итераций = <<Q>>
CLOSE ALL
QUIT
***************************************************************************
FUNCTION Split
PARAMETERS pPos, pLen, pSgn, pSrc, pIsEnd
LOCAL i, j, k, l
IF pPos < 1 OR pPos > Nmax
pIsEnd = .T.
RETURN .T.
ENDIF
IF Nmax == 1
pPos = 2
pLen = 1
pSgn = 1
RETURN .T.
ENDIF
&& Определяем тип порядка
pSgn = IIF(pPos < Nmax, IIF(pSrc[pPos+ 1 ] < pSrc[pPos], - 1 , 1 ), 1 )
&& Если пройдет весь цикл
NewPos = Nmax + 1
NewLen = Nmax - pPos + 1
FOR i = pPos TO Nmax - 1
IF(pSgn == 1 AND pSrc[i + 1 ] < pSrc[i]) OR (pSgn == - 1 AND pSrc[i + 1 ] >= pSrc[i])
NewPos = i + 1
NewLen = Newpos - pPos
pIsEnd = .F.
EXIT
ENDIF
ENDFOR
pPos = NewPos
pLen = NewLen
RETURN .T.
ENDFUNC
***************************************************************************
FUNCTION Merge
PARAMETERS pPos1, pLen1, pSgn1, pPos2, pLen2, pSgn2, pOutPos, pDst, pSrc1, pSrc2
IF pLen1 == 0 OR pLen2 == 0
RETURN .F.
ENDIF
IF pPos1 <= 0 OR pPos2 <= 0 OR pOutPos <= 0
RETURN .F.
ENDIF
LOCAL i, j, k, l
i = 0
j = 0
DO WHILE i < pLen1 AND j < pLen2
LVal = pSrc1[pPos1 + pSgn1*i]
RVal = pSrc2[pPos2 + pSgn2*j]
IF LVal <= RVal
pDst[pOutPos] = LVal
i = i + 1
pOutPos = pOutPos + 1
ENDIF
IF LVal >= RVal
pDst[pOutPos] = RVal
j = j + 1
pOutPos = pOutPos + 1
ENDIF
ENDDO
* Дописываем остаток, если он есть
IF i < pLen1
FOR l = i TO pLen1 - 1
pDst[pOutPos] = pSrc1[pPos1 + pSgn1*l]
pOutPos = pOutPos + 1
ENDFOR
ENDIF
IF j < pLen2
FOR l = j TO pLen2 - 1
pDst[pOutPos] = pSrc2[pPos2 + pSgn2*l]
pOutPos = pOutPos + 1
ENDFOR
ENDIF
RETURN .T.
ENDFUNC
***************************************************************************
***************************************************************************
|
