program RankArray;
{
This program demonstrates how to rank elements of an integer array
based on their sorted order.
Ranking rules:
--------------
- Lowest value gets rank 1
- Equal values share the same rank
- Rank increases only when encountering a new unique value
Steps:
1. Print the original array
2. Copy the array
3. Sort the copy
4. Build a rank array based on sorted order
5. Apply ranks to the original order
}
type
TIntArray = array of Integer;
{ ------------------------------------------------------------
Function 1: Print the array
------------------------------------------------------------ }
procedure PrintArray(arr: TIntArray);
var
i: Integer;
begin
Write('Array: [ ');
for i := 0 to High(arr) do
Write(arr[i], ' ');
Writeln(']');
end;
{ ------------------------------------------------------------
Function 2: Copy the array
------------------------------------------------------------ }
function CopyArray(arr: TIntArray): TIntArray;
var
i: Integer;
resultArr: TIntArray;
begin
SetLength(resultArr, Length(arr));
for i := 0 to High(arr) do
resultArr[i] := arr[i];
CopyArray := resultArr;
end;
{ ------------------------------------------------------------
Function 3: Sort the array (simple Bubble Sort for clarity)
------------------------------------------------------------ }
procedure SortArray(var arr: TIntArray);
var
i, j, temp: Integer;
begin
for i := 0 to High(arr) do
for j := 0 to High(arr) - 1 do
if arr[j] > arr[j + 1] then
begin
temp := arr[j];
arr[j] := arr[j + 1];
arr[j + 1] := temp;
end;
end;
{ ------------------------------------------------------------
Function 4: Build rank array based on sorted order
------------------------------------------------------------ }
function BuildRankArray(sorted: TIntArray): TIntArray;
var
i, rank: Integer;
rankArr: TIntArray;
begin
SetLength(rankArr, Length(sorted));
rank := 1;
rankArr[0] := rank;
for i := 1 to High(sorted) do
begin
if sorted[i] <> sorted[i - 1] then
Inc(rank);
rankArr[i] := rank;
end;
BuildRankArray := rankArr;
end;
{ ------------------------------------------------------------
Function 5: Apply ranks to original array order
------------------------------------------------------------ }
function ApplyRanks(original, sorted, rankArr: TIntArray): TIntArray;
var
i, j: Integer;
ranked: TIntArray;
begin
SetLength(ranked, Length(original));
for i := 0 to High(original) do
for j := 0 to High(sorted) do
if original[i] = sorted[j] then
begin
ranked[i] := rankArr[j];
Break;
end;
ApplyRanks := ranked;
end;
{ ------------------------------------------------------------
Main ranking function
------------------------------------------------------------ }
procedure RankArray(arr: TIntArray);
var
arrCopy, sorted, rankArr, ranked: TIntArray;
i: Integer;
begin
PrintArray(arr);
if Length(arr) = 0 then
Exit;
arrCopy := CopyArray(arr);
sorted := CopyArray(arrCopy);
SortArray(sorted);
rankArr := BuildRankArray(sorted);
ranked := ApplyRanks(arr, sorted, rankArr);
Write('Rank: [ ');
for i := 0 to High(ranked) do
Write(ranked[i], ' ');
Writeln(']');
end;
{ ------------------------------------------------------------
MAIN PROGRAM
------------------------------------------------------------ }
var
arr: TIntArray;
begin
arr := TIntArray.Create(33, 99, 10, 25, 47, 11, 77);
RankArray(arr);
end.
{
run:
Array: [ 33 99 10 25 47 11 77 ]
Rank: [ 4 7 1 3 5 2 6 ]
}