------------------------------------------------------------------------------
-- BUSH Stats Package Parser                                               --
--                                                                          --
-- Part of BUSH                                                             --
------------------------------------------------------------------------------
--                                                                          --
--              Copyright (C) 2001-2005 Ken O. Burtch & FSF                 --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca                             --
--                                                                          --
------------------------------------------------------------------------------
-- CVS: $Id: parser_stats.adb,v 1.2 2005/02/11 02:59:28 ken Exp $

with gnat.bubble_sort_a,
     gnat.heap_sort_a,
     ada.numerics.float_random,
     ada.numerics.long_elementary_functions,
     bush_os,
     string_util,
     world,
     scanner_arrays,
     parser,
     parser_aux;
use  ada.numerics.long_elementary_functions,
     bush_os,
     string_util,
     world,
     scanner_arrays,
     parser,
     parser_aux;

package body parser_stats is


---------------------------------------------------------
-- PARSE THE STATS PACKAGE
---------------------------------------------------------

procedure ParseStatsMax( f : out unbounded_string; kind : out identifier ) is
  var_id : identifier;
  first, last : long_integer;
  array_id : arrayID;
  max : long_float;
  max_string : unbounded_string;
begin
  expect( stats_max_t );
  expect( symbol_t, "(" );
  ParseIdentifier( var_id );
  if identifiers( var_id ).class = typeClass or identifiers( var_id ).class = subClass then
     var_id := getBaseType( var_id );
     if not identifiers( var_id ).list then
        err( "Array or array type expected" );
     end if;
  elsif not (class_ok( var_id, otherClass ) and identifiers( var_id ).list) then
     err( "Array or array type expected" );
  end if;
  if uniTypesOK( identifiers( var_id ).kind, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     array_id := arrayID( to_numeric( identifiers( var_id ).value ) );
     first := firstBound( array_id );
     last  := lastBound( array_id );
     max_string := arrayElement( array_id, first);
     max := to_numeric( max_string );
     for i in first+1..last loop
         if to_numeric( arrayElement( array_id, i) ) > max then
            max_string := arrayElement( array_id, i);
            max := to_numeric( max_string );
         end if;
     end loop;
     f := max_string;
     kind   := identifiers( identifiers( var_id ).kind ).kind;
  end if;
end ParseStatsMax;

procedure ParseStatsMin( f : out unbounded_string; kind : out identifier ) is
  var_id : identifier;
  first, last : long_integer;
  array_id : arrayID;
  min : long_float;
  min_string : unbounded_string;
begin
  expect( stats_min_t );
  expect( symbol_t, "(" );
  ParseIdentifier( var_id );
  if identifiers( var_id ).class = typeClass or identifiers( var_id ).class = subClass then
     var_id := getBaseType( var_id );
     if not identifiers( var_id ).list then
        err( "Array or array type expected" );
     end if;
  elsif not (class_ok( var_id, otherClass ) and identifiers( var_id ).list) then
     err( "Array or array type expected" );
  end if;
  if uniTypesOK( identifiers( var_id ).kind, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     array_id := arrayID( to_numeric( identifiers( var_id ).value ) );
     first := firstBound( array_id );
     last  := lastBound( array_id );
     min_string := arrayElement( array_id, first);
     min := to_numeric( min_string );
     for i in first+1..last loop
         if to_numeric( arrayElement( array_id, i) ) < min then
            min_string := arrayElement( array_id, i);
            min := to_numeric( min_string );
         end if;
     end loop;
     f := min_string;
     kind   := identifiers( identifiers( var_id ).kind ).kind;
  end if;
end ParseStatsMin;

procedure ParseStatsSum( f : out unbounded_string; kind : out identifier ) is
-- should really be in a stats package
  var_id : identifier;
  first, last : long_integer;
  array_id : arrayID;
  sum : long_float;
begin
  expect( stats_sum_t );
  expect( symbol_t, "(" );
  ParseIdentifier( var_id );
  if identifiers( var_id ).class = typeClass or identifiers( var_id ).class = subClass then
     var_id := getBaseType( var_id );
     if not identifiers( var_id ).list then
        err( "Array or array type expected" );
     end if;
  elsif not (class_ok( var_id, otherClass ) and identifiers( var_id ).list) then
     err( "Array or array type expected" );
  end if;
  if uniTypesOK( identifiers( var_id ).kind, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     array_id := arrayID( to_numeric( identifiers( var_id ).value ) );
     first := firstBound( array_id );
     last  := lastBound( array_id );
     sum := 0.0;
     for i in first..last loop
         sum := sum + to_numeric( arrayElement( array_id, i) );
     end loop;
     f := to_unbounded_string( sum );
     kind   := identifiers( identifiers( var_id ).kind ).kind;
  end if;
end ParseStatsSum;

procedure ParseStatsAverage( f : out unbounded_string; kind : out identifier ) is
  var_id : identifier;
  first, last : long_integer;
  len    : long_integer;
  array_id : arrayID;
  sum : long_float;
begin
  expect( stats_average_t );
  expect( symbol_t, "(" );
  ParseIdentifier( var_id );
  if identifiers( var_id ).class = typeClass or identifiers( var_id ).class = subClass then
     var_id := getBaseType( var_id );
     if not identifiers( var_id ).list then
        err( "Array or array type expected" );
     end if;
  elsif not (class_ok( var_id, otherClass ) and identifiers( var_id ).list) then
     err( "Array or array type expected" );
  end if;
  if uniTypesOK( identifiers( var_id ).kind, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     array_id := arrayID( to_numeric( identifiers( var_id ).value ) );
     first := firstBound( array_id );
     last  := lastBound( array_id );
     len   := last-first+1;
     sum := 0.0;
     for i in first..last loop
         sum := sum + to_numeric( arrayElement( array_id, i) );
     end loop;
     f := to_unbounded_string( sum / long_float( len ) );
     kind   := identifiers( identifiers( var_id ).kind ).kind;
  end if;
end ParseStatsAverage;

procedure ParseStatsVariance( f : out unbounded_string; kind : out identifier ) is
  var_id   : identifier;
  first, last : long_integer;
  len      : long_integer;
  array_id : arrayID;
  sum      : long_float;
  diff     : long_float;
  mean     : long_float;
  sum_diff_sq : long_float;
begin
  expect( stats_variance_t );
  expect( symbol_t, "(" );
  ParseIdentifier( var_id );
  if identifiers( var_id ).class = typeClass or identifiers( var_id ).class = subClass then
     var_id := getBaseType( var_id );
     if not identifiers( var_id ).list then
        err( "Array or array type expected" );
     end if;
  elsif not (class_ok( var_id, otherClass ) and identifiers( var_id ).list) then
     err( "Array or array type expected" );
  end if;
  if uniTypesOK( identifiers( var_id ).kind, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     array_id := arrayID( to_numeric( identifiers( var_id ).value ) );
     first := firstBound( array_id );
     last  := lastBound( array_id );
     len   := last-first+1;
     sum := 0.0;
     for i in first..last loop
         sum := sum + to_numeric( arrayElement( array_id, i) );
     end loop;
     mean := sum / long_float( len );
     sum_diff_sq := 0.0;
     for i in first..last loop
         diff := to_numeric( arrayElement( array_id, i ) ) - mean;
         sum_diff_sq := sum_diff_sq + diff * diff;
     end loop;
     f := to_unbounded_string( sum_diff_sq / long_float( len-1 ) );
     -- kind   := identifiers( var_id ).kind;
     kind   := identifiers( identifiers( var_id ).kind ).kind;
  end if;
end ParseStatsVariance;

procedure ParseStatsStandardDeviation( f : out unbounded_string; kind : out identifier ) is
  var_id   : identifier;
  first, last : long_integer;
  len      : long_integer;
  array_id : arrayID;
  sum      : long_float;
  diff     : long_float;
  mean     : long_float;
  sum_diff_sq : long_float;
begin
  expect( stats_standard_deviation_t );
  expect( symbol_t, "(" );
  ParseIdentifier( var_id );
  if identifiers( var_id ).class = typeClass or identifiers( var_id ).class = subClass then
     var_id := getBaseType( var_id );
     if not identifiers( var_id ).list then
        err( "Array or array type expected" );
     end if;
  elsif not (class_ok( var_id, otherClass ) and identifiers( var_id ).list) then
     err( "Array or array type expected" );
  end if;
  if uniTypesOK( identifiers( var_id ).kind, uni_numeric_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     array_id := arrayID( to_numeric( identifiers( var_id ).value ) );
     first := firstBound( array_id );
     last  := lastBound( array_id );
     len   := last-first+1;
     sum := 0.0;
     for i in first..last loop
         sum := sum + to_numeric( arrayElement( array_id, i) );
     end loop;
     mean := sum / long_float( len );
     sum_diff_sq := 0.0;
     for i in first..last loop
         diff := to_numeric( arrayElement( array_id, i ) ) - mean;
         sum_diff_sq := sum_diff_sq + diff * diff;
     end loop;
     f := to_unbounded_string( sqrt( sum_diff_sq / long_float( len-1 ) ) );
     -- kind   := identifiers( var_id ).kind;
     kind   := identifiers( identifiers( var_id ).kind ).kind;
  end if;
end ParseStatsStandardDeviation;

-------------------------------------------------------------------------------
-- Housekeeping
-------------------------------------------------------------------------------

procedure StartupStats is
begin
  declareProcedure( stats_average_t, "stats.average" );
  declareProcedure( stats_max_t, "stats.max" );
  declareProcedure( stats_min_t, "stats.min" );
  declareProcedure( stats_standard_deviation_t, "stats.standard_deviation" );
  declareProcedure( stats_sum_t, "stats.sum" );
  declareProcedure( stats_variance_t, "stats.variance" );
end StartupStats;

procedure ShutdownStats is
begin
  null;
end ShutdownStats;

end parser_stats;
