lewertssc.mod

IMPLEMENTATION MODULE LewertsScale;

(* Modula-2 implementation by John Andrea, Oct.8/92 *)

FROM MathLib0 IMPORT sqrt, power;
FROM MoreMath IMPORT Log10;

VAR
  n_set    :CARDINAL;
  nice_set :ARRAY [1..4] OF REAL;
 
      (* ---------------------------------------------------------- *)
       PROCEDURE Scale( data_min, data_max :REAL; approx_inc :CARDINAL;
                       VAR scale_min, scale_max, scale_inc :REAL );
      (* Implementation notes:
       * 1) should n_set be large enough to include the 10 or not.
       *    The book is confusing as it is given in C and there is some
       *    comment about including the 10 for a special purpose.
       * 2) there seems to be a problem with the given algorithm in
       *    computing the scale-max, so do a hack here to fix it
       * 3) there seems to be a problem with the given algorithm in
       *    computing the scale-min, so do a hack here to fix it
      *)

      VAR
        actual_inc :INTEGER;

        interval_size :REAL;

        set_index :CARDINAL;
        power_of_ten :REAL;

        nice_num, geo_mean :REAL;

        n_low_mul, n_hi_mul  :INTEGER;

      BEGIN

        IF approx_inc < 2 THEN
          actual_inc := 2;
        ELSE
          actual_inc := INTEGER( approx_inc );
        END;

        IF data_min > data_max THEN
          nice_num := data_min;
          data_min := data_max;
          data_max := nice_num;
        ELSE    
        
          (* compute the smallest potential interval *)
          interval_size := ( data_max - data_min ) / FLOAT( actual_inc );

          (* compute the nice number closest to the approximate potential interval *)
          FirstNiceNum( interval_size, set_index, power_of_ten, nice_num );
 
          geo_mean := sqrt( nice_set[set_index] * nice_set[set_index+1] );

          WHILE geo_mean * power_of_ten < interval_size DO

             NextNiceNum( set_index, power_of_ten, nice_num );

             geo_mean := sqrt( nice_set[set_index] * nice_set[set_index+1] );
          END;

          (* produce the scale using the computed nice number *)
          CalcExtLabel( data_min, data_max, nice_num, n_low_mul, n_hi_mul );

          (* and the scale limits *)
          scale_min  := FLOAT( n_low_mul ) * nice_num;
          scale_max  := FLOAT( n_hi_mul  ) * nice_num;
          actual_inc := n_hi_mul - n_low_mul;

          (* heres the hack to fix the scale_max *)
          scale_inc := ( scale_max - scale_min ) / FLOAT( actual_inc );

          WHILE scale_max < data_max DO
             scale_max := scale_max + nice_num;
          END;

          (* and fix scale_min too *)
          WHILE scale_min > data_min DO
             scale_min := scale_min - nice_num;
          END;

      END;
   END Scale;

       (* ---------------------------------------------------------- *)
      PROCEDURE CalcExtLabel( data_min, data_max, nice_num :REAL;
                              VAR n_low, n_high :INTEGER);
      (* calculate an externally labeled scale *)
      VAR
        check :REAL;
      BEGIN
      
        (* calculate the low multiple *)
        n_low := TRUNC( data_min / nice_num );

        (* double check it *)
        (* make sure that we've got the largest possible minimum *)
        check := FLOAT( n_low + 1 ) * nice_num;
        IF check <= data_min THEN
          n_low := n_low + 1;
        END;

        (* calculate the high multiple *)
        n_high := TRUNC( ( data_max / nice_num ) + 0.5 );

        (* double check it *)
        (* make sure that we've got the smallest possible maximum *)
        check := FLOAT( n_high - 1 ) * nice_num;
        IF check >= data_max THEN
          n_high := n_high - 1;
        END;

    END CalcExtLabel;

       (* ---------------------------------------------------------- *)
    PROCEDURE FirstNiceNum( interval_size :REAL; 
                            VAR set_index :CARDINAL;
                            VAR power_of_ten, nice_num :REAL );

    (* calculate an initial value for the nice-number *)
    (* Implementation notes: *)
    (*   1) can a real be raised to a negative integer power ? *)

    VAR
      exponent :INTEGER;
       
    BEGIN
    
      (* calculate an initial power of ten *)
      exponent := TRUNC( Log10( interval_size ) );
      power_of_ten := power( 10.0, FLOAT( exponent ) );

      (* double check it *)
      IF power_of_ten * 10.0 <= interval_size THEN
        power_of_ten := power_of_ten * 10.0;
      END;

      (* and the index into the set of number is initialy the first number *)
      set_index := 1;

      (* and return the first nice-number *)
      nice_num := power_of_ten;

    END FirstNiceNum;

      (* ---------------------------------------------------------- *)
      PROCEDURE NextNiceNum( VAR set_index :CARDINAL;
                             VAR power_of_ten, nice_num :REAL );

      (* calculate the next value for the nice-number *)
      (* Implementation notes: *)
      (*  1) should the check for the exceeded set size *)
      (*     be ".ge." as it is in the book, or ".gt." *)
      (*     since FORTRAN starts indicies at one rather *)
      (*     than starting at zero as in the book. *)

      BEGIN
      
        (* increment the index *)
        set_index := set_index + 1;

        (* if the maximum has been passed, then reset index to first *)
        (* position, and increase the power of ten *)

        IF set_index > n_set THEN
          set_index    := 1;
          power_of_ten := power_of_ten * 10.0;
        END;

        (* and return the next nice number *)

        nice_num := nice_set[set_index] * power_of_ten;

      END NextNiceNum;

BEGIN

 n_set := 3; (* actual length less one *)

 nice_set[1] := 1.0;  nice_set[2] := 2.0;
 nice_set[3] := 5.0;  nice_set[4] := 10.0;

END LewertsScale.