0010/* PQUICK 0020/* QUICK-Sort 0030/* Klaus-Peter Plog 0040/* 0050DEFINE DATA LOCAL 0060/*-------------------------------------------------- Array definition 00701 #N(I2) INIT <500> 00801 #A(I4/500) 00901 #W(I4) 01001 #X(I4) 0110/*------------------------------------ variables for Sort 01201 #L(I2) /* left 01301 #R(I2) /* right 01401 #I(I2) 01501 #J(I2) 01601 #K(I2) 0170/*---------------- definition of stack (100 elements should be enough!) 01801 #SL-TAB(I2/100) 01901 #SR-TAB(I2/100) 02001 #SI(I2) 02101 #SR(I2) 02201 #SL(I2) 0230END-DEFINE 0240/*--------------------------- fill array the other way round 0250FOR #I = 1 TO #N 0260 COMPUTE #A(#I) = #N - #I 0270END-FOR 0280/*--------------------------------------------------------- sort! 0290WRITE #A(1:5) 0300ZEIT. SETTIME 0310PERFORM SORT 0320WRITE 'in' *TIMD(ZEIT.) (EM=99:99':'99'.'9) #N 'elements have been sorted' 0330WRITE #A(1:5) 0340/* 0350DEFINE SUBROUTINE SORT /*============================================= 0360RESET #SI 0370ASSIGN #SL = 1 0380ASSIGN #SR = #N 0390PERFORM PUSH 0400REPEAT WHILE #SI >= 1 0410 PERFORM PULL 0420 ASSIGN #L = #SL 0430 ASSIGN #R = #SR 0440 PERFORM QSORT 0450END-REPEAT 0460END-SUBROUTINE /*======================================================= 0470/* 0480DEFINE SUBROUTINE QSORT /*============================================== 0490ASSIGN #I = #L 0500ASSIGN #J = #R 0510COMPUTE #K = (#L + #R) / 2 0520ASSIGN #X = #A(#K) 0530REPEAT 0540 REPEAT WHILE #A(#I) < #X 0550 COMPUTE #I = #I + 1 0560 END-REPEAT 0570 REPEAT WHILE #X < #A(#J) 0580 COMPUTE #J = #J - 1 0590 END-REPEAT 0600 IF #I <= #J THEN 0610 ASSIGN #W = #A(#I) 0620 ASSIGN #A(#I) = #A(#J) 0630 ASSIGN #A(#J) = #W 0640 COMPUTE #I = #I + 1 0650 COMPUTE #J = #J - 1 0660 END-IF 0670 UNTIL #I > #J 0680END-REPEAT 0690/* 0700IF #L < #J THEN 0710 ASSIGN #SL = #L 0720 ASSIGN #SR = #J 0730 PERFORM PUSH 0740END-IF 0750IF #I < #R THEN 0760 ASSIGN #SL = #I 0770 ASSIGN #SR = #R 0780 PERFORM PUSH 0790END-IF 0800END-SUBROUTINE /*======================================================= 0810/* 0820DEFINE SUBROUTINE PUSH /* ============================================== 0830COMPUTE #SI = #SI + 1 0840ASSIGN #SL-TAB(#SI) = #SL 0850ASSIGN #SR-TAB(#SI) = #SR 0860END-SUBROUTINE /*======================================================= 0870/* 0880DEFINE SUBROUTINE PULL /* ============================================== 0890ASSIGN #SL = #SL-TAB(#SI) 0900ASSIGN #SR = #SR-TAB(#SI) 0910COMPUTE #SI = #SI - 1 0920END-SUBROUTINE /*======================================================= 0930/* 0940END