Implementations of Grade

Beginning an implementation of an early English Elision with Ada had, as is typical, revealed points
of ignorance in my thinking, leading me to play with APL, which is more suited to the vague problem.
This was valuable, as I recognized the APL grading function, which returns the indices of the sorted
array in terms of the input array, was that primitive I need to reorganize the auxiliary dictionary.

This provided a suitable grounds for thinking about this problem, better than combining both sorting
and translation table generation, as I'd originally considered.  The desire to avoid writing sorting
itself lead to a simple solution, I believe inspired by the Common Lisp and its &KEY parameter, this
being to generate a vector of indices and then sorting it, with indirection sorting using the input.

These programs are licensed under the GNU Affero General Public License version three.

The Common Lisp was written with little effort:


(defun grade (sort vector &optional stable-sort &key ((:key every) 'identity))
  "This function returns a vector of indices corresponding to the sorted order of the input vector."
  (let ((array (make-array #0=(length vector) :element-type `(integer 0 ,(max 0 (1- #0#)))
                           :initial-contents (loop :for count :from 0 :repeat #0# :collect count))))
    ;Through the compiler, this function goes.  Would :INITIAL-CONTENTS be best?  Well nobody knows!
    ;(dotimes (count #0#) (setf (aref array count) count))
    (funcall (if stable-sort 'stable-sort 'sort)
             array sort :key (lambda (aref) (funcall every (aref vector aref))))))


The Ada required the most effort, but worked at first test after changing some semicolons to commas,
sans that case of the null array, which required me to change the body of the main subprogram.  This
is the best version, being generic and handling any indices nicely, and I usually find the Ada best:


grade.ads:
generic
   type   Index_Type is (<>);
   type Element_Type is private;
   type  Vector_Type is array (Index_Type range <>) of Element_Type;
   type  Result_Type is array (Index_Type range <>) of Index_Type;
   with function "<" (Left, Right : in Element_Type) return Boolean is <>;
function Grade (Data : in Vector_Type) return Result_Type;


grade.adb:
with Ada.Containers.Generic_Array_Sort;

-- This generic function returns a vector of indices which correspond to the sorted indices of Data.
-- The indices returned are those same used by Data.  It seems using the result requires O(N) space.
function Grade (Data : in Vector_Type) return Result_Type is
   -- The Iota is named after that from APL, returning a vector with each index resolving to itself.
   -- Using the Base type avoids that edge case of a null array, with boundaries not of the subtype.
   -- It does sicken me how these null array bounds can be so lax I must use the Base type for both.
   function Iota ( First : in Index_Type'Base := Index_Type'First;
                  Second : in Index_Type'Base := Index_Type'Last) return Result_Type is
      R : Result_Type(First .. Second);
   begin
      for I in R'Range loop
         R(I) := I;
      end loop;
      return R;
   end Iota;
   -- This function is the key to using a predefined sorting subprogram, exploiting its indirection.
   -- Controlling the comparison function permits sorting an array based on the contents of another.
   function Sorting_Indirection (Left, Right : in Index_Type) return Boolean is
   begin
      return Data(Left) < Data(Right);
   end Sorting_Indirection;
   -- I may find myself wanting for Ada.Containers.Generic_Sort later; using it's unreasonable here.
   -- It's disappointing I seem to need Ada 2012 purely for want of a predefined sorting subprogram.
   procedure Sort is new Ada.Containers.Generic_Array_Sort
     (Index_Type =>  Index_Type, Element_Type => Index_Type,
      Array_Type => Result_Type, "<" => Sorting_Indirection);
   -- Were the sorting subprogram a function this would be unnecessary, and it would be a lone line.
   R : Result_Type := Iota(Data'First, Data'Last);
begin -- With this preparation finished, the remainder of the body is trivial, and so rather pretty.
   Sort(R);
   return R;
end Grade;


test.adb:
with Grade, Ada.Text_IO;

procedure Test is
   type Index_Array is array (Positive range <>) of Positive;
   function Testing is new Grade (Positive, Character, String, Index_Array);
   package Integer_IO is new Ada.Text_IO.Integer_IO (Positive);
   R : Index_Array := Testing(Ada.Text_IO.Get_Line);
begin
   for I of R loop
      Integer_IO.Put(I); Ada.Text_IO.Put(' ');
   end loop;
end Test;

Copyright (C) 2021,2022 Prince Trippy
.