-- ----------------------------------------------------------------------- -- Title: test_relerr_elem -- Last Mod: Tue Oct 2 09:06:44 1990 -- Author: Vincent Broman -- Visibility: main program -- Description: -- This program tests an implementation of -- generic_elementary_functions for accuracy by Monte Carlo -- sampling of the domains of the functions. -- Error information is writtten to stdout. -- Exceptions: should be none -- ----------------------------------------------------------------------- with random_number, float_types, single_elementary_functions, double_elementary_functions, test_relerr_1, test_relerr_2, text_io; use float_types, text_io; procedure test_relerr_elem is -- package selem renames single_elementary_functions; package delem renames double_elementary_functions; subtype real is single; subtype long_real is double; niter: integer; rand_seed1, rand_seed2: integer; two_eps: constant long_real := long_real( 2.0 * real'base'epsilon); four_eps: constant long_real := long_real( 4.0 * real'base'epsilon); eight_eps: constant long_real := long_real( 8.0 * real'base'epsilon); small: constant real := real'base'safe_small; big: constant real := real'base'safe_large; half_mant: constant real := 6433.0; avg_err, max_err, worst_arg, worst_arg2: long_real; package sfio is new text_io.float_io( real); use sfio; package dfio is new text_io.float_io( long_real); use dfio; package iio is new text_io.integer_io( integer); use iio; procedure report_header is begin -- twelve-space fields below, one line per tested functions put( "func name requ'd eps avg_err/eps max_err/eps worst_arg"); new_line; end report_header; procedure report( name: string; eps: in long_real; avg_err: in long_real; max_err: in long_real; worst_arg: in long_real) is -- field_size: constant integer := 12; blanks: string( 1 .. field_size) := " "; begin put( name); put( blanks( 1 .. field_size - name'length)); put( eps, 1, field_size-7, 2); put( " "); put( avg_err, 1, field_size-3, 0); put( " "); put( max_err, 1, field_size-3, 0); put( " "); put( worst_arg, 1, real'base'digits+1, 2); new_line; end report; procedure report_header2 is begin -- twelve-space fields below, one line per tested functions put( "func name requ'd eps avg_err/eps max_err/eps worst_arg worst_arg2" ); new_line; end report_header2; procedure report2( name: string; eps: in long_real; avg_err: in long_real; max_err: in long_real; worst_arg, worst_arg2: in long_real) is -- field_size: constant integer := 12; blanks: string( 1 .. field_size) := " "; begin put( name); put( blanks( 1 .. field_size - name'length)); put( eps, 1, field_size-7, 2); put( " "); put( avg_err, 1, field_size-3, 0); put( " "); put( max_err, 1, field_size-3, 0); put( " "); put( worst_arg, 1, real'base'digits+1, 2); put( " "); put( worst_arg2, 1, real'base'digits+1, 2); new_line; end report2; -- every function but "**" has an error bound proportional to epsilon. -- "**" needs an extra factor involving the log of the result. function proport( res: long_real) return long_real is begin return 1.0; end proport; function log_res_fac( res: long_real) return long_real is begin return 1.0 + delem.log( res) / 128.0; end log_res_fac; -- arctan and arccot have default arguments -- instead of purely single-argument versions. function selem_arctan( y: in real) return real is begin return selem.arctan( y); end selem_arctan; function delem_arctan( y: in long_real) return long_real is begin return delem.arctan( y); end delem_arctan; function selem_arccot( x: in real) return real is begin return selem.arccot( x); end selem_arccot; function delem_arccot( x: in long_real) return long_real is begin return delem.arccot( x); end delem_arccot; function selem_arctan2( a1, a2: in real) return real is begin return selem.arctan( a1, a2); end selem_arctan2; function delem_arctan2( a1, a2: in long_real) return long_real is begin return delem.arctan( a1, a2); end delem_arctan2; function selem_arccot2( a1, a2: in real) return real is begin return selem.arccot( a1, a2); end selem_arccot2; function delem_arccot2( a1, a2: in long_real) return long_real is begin return delem.arccot( a1, a2); end delem_arccot2; function selem_arctand( a1, a2: in real) return real is begin return selem.arctan( a1, a2, 360.0); end selem_arctand; function delem_arctand( a1, a2: in long_real) return long_real is begin return delem.arctan( a1, a2, 360.0); end delem_arctand; function selem_arccotd( a1, a2: in real) return real is begin return selem.arccot( a1, a2, 360.0); end selem_arccotd; function delem_arccotd( a1, a2: in long_real) return long_real is begin return delem.arccot( a1, a2, 360.0); end delem_arccotd; procedure test_sqrt is new test_relerr_1( real, long_real, selem.sqrt, delem.sqrt, two_eps, exp_dist_arg=> true); procedure test_log is new test_relerr_1( real, long_real, selem.log, delem.log, four_eps, exp_dist_arg=> true); procedure test_exp is new test_relerr_1( real, long_real, selem.exp, delem.exp, four_eps, exp_dist_arg=> false); procedure test_sin is new test_relerr_1( real, long_real, selem.sin, delem.sin, two_eps, exp_dist_arg=> false); procedure test_cos is new test_relerr_1( real, long_real, selem.cos, delem.cos, two_eps, exp_dist_arg=> false); procedure test_tan is new test_relerr_1( real, long_real, selem.tan, delem.tan, four_eps, exp_dist_arg=> false); procedure test_cot is new test_relerr_1( real, long_real, selem.cot, delem.cot, four_eps, exp_dist_arg=> false); procedure test_arcsin is new test_relerr_1( real, long_real, selem.arcsin, delem.arcsin, four_eps, exp_dist_arg=> false); procedure test_arccos is new test_relerr_1( real, long_real, selem.arccos, delem.arccos, four_eps, exp_dist_arg=> false); procedure test_arctan is new test_relerr_1( real, long_real, selem_arctan, delem_arctan, four_eps, exp_dist_arg=> true); procedure test_arccot is new test_relerr_1( real, long_real, selem_arccot, delem_arccot, four_eps, exp_dist_arg=> true); procedure test_sinh is new test_relerr_1( real, long_real, selem.sinh, delem.sinh, eight_eps, exp_dist_arg=> false); procedure test_cosh is new test_relerr_1( real, long_real, selem.cosh, delem.cosh, eight_eps, exp_dist_arg=> false); procedure test_tanh is new test_relerr_1( real, long_real, selem.tanh, delem.tanh, eight_eps, exp_dist_arg=> true); procedure test_coth is new test_relerr_1( real, long_real, selem.coth, delem.coth, eight_eps, exp_dist_arg=> true); procedure test_arcsinh is new test_relerr_1( real, long_real, selem.arcsinh, delem.arcsinh, eight_eps, exp_dist_arg=> true); procedure test_arccosh is new test_relerr_1( real, long_real, selem.arccosh, delem.arccosh, eight_eps, exp_dist_arg=> true); procedure test_arctanh is new test_relerr_1( real, long_real, selem.arctanh, delem.arctanh, eight_eps, exp_dist_arg=> false); procedure test_arccoth is new test_relerr_1( real, long_real, selem.arccoth, delem.arccoth, eight_eps, exp_dist_arg=> true); procedure test_log2 is new test_relerr_2( real, long_real, selem.log, delem.log, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_exp2 is new test_relerr_2( real, long_real, selem."**", delem."**", four_eps, log_res_fac, exp_dist_arg1=> true, exp_dist_arg2=> false); procedure test_sin2 is new test_relerr_2( real, long_real, selem.sin, delem.sin, two_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_cos2 is new test_relerr_2( real, long_real, selem.cos, delem.cos, two_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_tan2 is new test_relerr_2( real, long_real, selem.tan, delem.tan, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_cot2 is new test_relerr_2( real, long_real, selem.cot, delem.cot, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_arcsin2 is new test_relerr_2( real, long_real, selem.arcsin, delem.arcsin, four_eps, proport, exp_dist_arg1=> false, exp_dist_arg2=> true); procedure test_arccos2 is new test_relerr_2( real, long_real, selem.arccos, delem.arccos, four_eps, proport, exp_dist_arg1=> false, exp_dist_arg2=> true); procedure test_arctan2 is new test_relerr_2( real, long_real, selem_arctan2, delem_arctan2, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_arccot2 is new test_relerr_2( real, long_real, selem_arccot2, delem_arccot2, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_arctand is new test_relerr_2( real, long_real, selem_arctand, delem_arctand, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); procedure test_arccotd is new test_relerr_2( real, long_real, selem_arccotd, delem_arccotd, four_eps, proport, exp_dist_arg1=> true, exp_dist_arg2=> true); begin put( "Test of relative accuracy of single-arg elementary functions."); new_line; new_line; put( "Enter the number of Monte Carlo trials to perform."); new_line; get( niter); put( "number of trials for each function= "); put( niter); new_line; put( "Enter two integer seeds for the random number generation."); new_line; get( rand_seed1); get( rand_seed2); put( "random number seeds= "); put( rand_seed1); put( ", "); put( rand_seed2); new_line; random_number.start( rand_seed1, rand_seed2); report_header; test_sqrt( niter, small, big, avg_err, max_err, worst_arg); report( "sqrt", two_eps, avg_err, max_err, worst_arg); test_log( niter, small, big, avg_err, max_err, worst_arg); report( "log", four_eps, avg_err, max_err, worst_arg); test_exp( niter, -89.0, 89.0, avg_err, max_err, worst_arg); report( "exp", four_eps, avg_err, max_err, worst_arg); test_sin( niter, -half_mant, half_mant, avg_err, max_err, worst_arg); report( "sin", two_eps, avg_err, max_err, worst_arg); test_cos( niter, -half_mant, half_mant, avg_err, max_err, worst_arg); report( "cos", two_eps, avg_err, max_err, worst_arg); test_tan( niter, -half_mant, half_mant, avg_err, max_err, worst_arg); report( "tan", four_eps, avg_err, max_err, worst_arg); test_cot( niter/2, small, half_mant, avg_err, max_err, worst_arg); report( "cot", four_eps, avg_err, max_err, worst_arg); test_cot( niter/2, -half_mant, -small, avg_err, max_err, worst_arg); report( "cot-", four_eps, avg_err, max_err, worst_arg); test_arcsin( niter, -1.0, 1.0, avg_err, max_err, worst_arg); report( "arcsin", four_eps, avg_err, max_err, worst_arg); test_arccos( niter, -1.0, 1.0, avg_err, max_err, worst_arg); report( "arccos", four_eps, avg_err, max_err, worst_arg); test_arctan( niter/2, small, big, avg_err, max_err, worst_arg); report( "arctan", four_eps, avg_err, max_err, worst_arg); test_arctan( niter/2, -small, -big, avg_err, max_err, worst_arg); report( "arctan-", four_eps, avg_err, max_err, worst_arg); test_arccot( niter/2, small, big, avg_err, max_err, worst_arg); report( "arccot", four_eps, avg_err, max_err, worst_arg); test_arccot( niter/2, -small, -big, avg_err, max_err, worst_arg); report( "arccot-", four_eps, avg_err, max_err, worst_arg); test_sinh( niter, -90.0, 90.0, avg_err, max_err, worst_arg); report( "sinh", eight_eps, avg_err, max_err, worst_arg); test_cosh( niter, -90.0, 90.0, avg_err, max_err, worst_arg); report( "cosh", eight_eps, avg_err, max_err, worst_arg); test_tanh( niter/2, small, big, avg_err, max_err, worst_arg); report( "tanh", eight_eps, avg_err, max_err, worst_arg); test_tanh( niter/2, -small, -big, avg_err, max_err, worst_arg); report( "tanh-", eight_eps, avg_err, max_err, worst_arg); test_coth( niter/2, small, big, avg_err, max_err, worst_arg); report( "coth", eight_eps, avg_err, max_err, worst_arg); test_coth( niter/2, -small, -big, avg_err, max_err, worst_arg); report( "coth-", eight_eps, avg_err, max_err, worst_arg); test_arcsinh( niter/2, small, big, avg_err, max_err, worst_arg); report( "arcsinh", eight_eps, avg_err, max_err, worst_arg); test_arcsinh( niter/2, -small, -big, avg_err, max_err, worst_arg); report( "arcsinh-", eight_eps, avg_err, max_err, worst_arg); test_arccosh( niter, 1.0, big, avg_err, max_err, worst_arg); report( "arccosh", eight_eps, avg_err, max_err, worst_arg); test_arctanh( niter, -1.0, 1.0, avg_err, max_err, worst_arg); report( "arctanh", eight_eps, avg_err, max_err, worst_arg); test_arccoth( niter/2, 1.0, big, avg_err, max_err, worst_arg); report( "arccoth", eight_eps, avg_err, max_err, worst_arg); test_arccoth( niter/2, -1.0, -big, avg_err, max_err, worst_arg); report( "arccoth-", eight_eps, avg_err, max_err, worst_arg); put( "Test of relative accuracy of double-arg elementary functions."); new_line; new_line; report_header2; test_log2( niter, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "log2", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_exp2( niter, small, big, -500.0, 500.0, avg_err, max_err, worst_arg, worst_arg2); report2( "exp2", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_sin2( niter/2, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "sin2", two_eps, avg_err, max_err, worst_arg, worst_arg2); test_sin2( niter/2, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "sin2-", two_eps, avg_err, max_err, worst_arg, worst_arg2); test_cos2( niter/2, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "cos2", two_eps, avg_err, max_err, worst_arg, worst_arg2); test_cos2( niter/2, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "cos2-", two_eps, avg_err, max_err, worst_arg, worst_arg2); test_tan2( niter/2, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "tan2", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_tan2( niter/2, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "tan2-", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_cot2( niter/2, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "cot2", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_cot2( niter/2, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "cot2-", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arcsin2( niter, -1.0, 1.0, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arcsin2", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccos2( niter, -1.0, 1.0, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccos2", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctan2( niter/4, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctan2++", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctan2( niter/4, small, big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctan2+-", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctan2( niter/4, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctan2-+", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctan2( niter/4, -small, -big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctan2--", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccot2( niter/4, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccot2++", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccot2( niter/4, small, big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccot2+-", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccot2( niter/4, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccot2-+", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccot2( niter/4, -small, -big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccot2--", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctand( niter/4, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctand++", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctand( niter/4, small, big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctand+-", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctand( niter/4, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctand-+", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arctand( niter/4, -small, -big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arctand--", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccotd( niter/4, small, big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccotd++", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccotd( niter/4, small, big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccotd+-", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccotd( niter/4, -small, -big, small, big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccotd-+", four_eps, avg_err, max_err, worst_arg, worst_arg2); test_arccotd( niter/4, -small, -big, -small, -big, avg_err, max_err, worst_arg, worst_arg2); report2( "arccotd--", four_eps, avg_err, max_err, worst_arg, worst_arg2); put( "Test done."); new_line; new_line; end test_relerr_elem;