How to rank elements of an integer array based on their sorted order in Pascal

1 Answer

0 votes
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 ]

}

 



answered 2 days ago by avibootz

Related questions

...