Код на Обероне. Не проверял компиляцию.
PROCEDURE Sort (VAR a: ARRAY 5 OF INTEGER);
VAR
NumLeaders: INTEGER;
PROCEDURE Exchange (LeftInd, RightInd: INTEGER);
VAR
TransfValue: INTEGER;
BEGIN
TransfValue := a[LeftInd];
a[LeftInd] := a[RightInd];
a[RightInd] := TransfValue;
END Exchange;
PROCEDURE MoveLeaderRight (FromInd: INTEGER);
VAR
i: INTEGER;
BEGIN
FOR i := FromInd TO LEN(a) - 1 - NumLeaders DO
Exchange(i, i + 1);
END;
END MoveRight;
(* Makes ChainLen - 1 comparisons *)
PROCEDURE FindLeader (LeftInd, ChainLen: INTEGER);
BEGIN
(* A B C => A MAX(B, C) MIN(B, C) *)
IF ChainLen = 3 THEN
IF a[LeftInd + 1] > a[LeftInd + 2] THEN
Exchange(LeftInd + 1, LeftInd + 2);
END;
END;
(* A B *)
IF a[LeftInd] > a[LeftInd + 1] THEN
MoveLeaderRight(LeftInd);
ELSE
MoveLeaderRight(LeftInd + 1);
END;
END FindLeader;
BEGIN
NumLeaders := 0;
FindLeader(0, 3); (* [A B C] D E => A B D E 1? *)
FindLeader(2, 2); (* A B [D E] 1? => A B D 1? 1? *)
FindLeader(3, 2); (* A B D [1? 1?] => A B D 2 1 *) NumLeaders := 2;
FindLeader(0, 3); (* [A B D] 2 1 => [A B] 3 2 1 *) NumLeaders := 3;
FindLeader(0, 2); (* [A B] 3 2 1 => 5 4 3 2 1 *)
(* 2 + 1 + 1 + 2 + 1 = 7 comparisons *)
END Sort;
