52 lines
2.8 KiB
Fortran
52 lines
2.8 KiB
Fortran
INTEGER FUNCTION FINDELEMENT(K,A,N) !I know I can.
|
|
Chase an order statistic: FindElement(N/2,A,N) leads to the median, with some odd/even caution.
|
|
Careful! The array is shuffled: for i < K, A(i) <= A(K); for i > K, A(i) >= A(K).
|
|
Charles Anthony Richard Hoare devised this method, as related to his famous QuickSort.
|
|
INTEGER K,N !Find the K'th element in order of an array of N elements, not necessarily in order.
|
|
INTEGER A(N),HOPE,PESTY !The array, and like associates.
|
|
INTEGER L,R,L2,R2 !Fingers.
|
|
L = 1 !Here we go.
|
|
R = N !The bounds of the work area within which the K'th element lurks.
|
|
DO WHILE (L .LT. R) !So, keep going until it is clamped.
|
|
HOPE = A(K) !If array A is sorted, this will be rewarded.
|
|
L2 = L !But it probably isn't sorted.
|
|
R2 = R !So prepare a scan.
|
|
DO WHILE (L2 .LE. R2) !Keep squeezing until the inner teeth meet.
|
|
DO WHILE (A(L2) .LT. HOPE) !Pass elements less than HOPE.
|
|
L2 = L2 + 1 !Note that at least element A(K) equals HOPE.
|
|
END DO !Raising the lower jaw.
|
|
DO WHILE (HOPE .LT. A(R2)) !Elements higher than HOPE
|
|
R2 = R2 - 1 !Are in the desired place.
|
|
END DO !And so we speed past them.
|
|
IF (L2 - R2) 1,2,3 !How have the teeth paused?
|
|
1 PESTY = A(L2) !On grit. A(L2) > HOPE and A(R2) < HOPE.
|
|
A(L2) = A(R2) !So swap the two troublemakers.
|
|
A(R2) = PESTY !To be as if they had been in the desired order all along.
|
|
2 L2 = L2 + 1 !Advance my teeth.
|
|
R2 = R2 - 1 !As if they hadn't paused on this pest.
|
|
3 END DO !And resume the squeeze, hopefully closing in K.
|
|
IF (R2 .LT. K) L = L2 !The end point gives the order position of value HOPE.
|
|
IF (K .LT. L2) R = R2 !But we want the value of order position K.
|
|
END DO !Have my teeth met yet?
|
|
FINDELEMENT = A(K) !Yes. A(K) now has the K'th element in order.
|
|
END FUNCTION FINDELEMENT !Remember! Array A has likely had some elements moved!
|
|
|
|
PROGRAM POKE
|
|
INTEGER FINDELEMENT !Not the default type for F.
|
|
INTEGER N !The number of elements.
|
|
PARAMETER (N = 10) !Fixed for the test problem.
|
|
INTEGER A(66) !An array of integers.
|
|
DATA A(1:N)/9, 8, 7, 6, 5, 0, 1, 2, 3, 4/ !The specified values.
|
|
|
|
WRITE (6,1) A(1:N) !Announce, and add a heading.
|
|
1 FORMAT ("Selection of the i'th element in order from an array.",/
|
|
1 "The array need not be in order, and may be reordered.",/
|
|
2 " i Val:Array elements...",/,8X,666I2)
|
|
|
|
DO I = 1,N !One by one,
|
|
WRITE (6,2) I,FINDELEMENT(I,A,N),A(1:N) !Request the i'th element.
|
|
2 FORMAT (I3,I4,":",666I2) !Match FORMAT 1.
|
|
END DO !On to the next trial.
|
|
|
|
END !That was easy.
|