Arithmetic equality fixed.
This commit is contained in:
parent
b97401bfde
commit
d7e0220674
6 changed files with 117 additions and 27 deletions
|
|
@ -748,3 +748,29 @@ struct cons_pointer lisp_divide( struct
|
|||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Function: return a real (approcimately) equal in value to the ratio
|
||||
* which is the first argument.
|
||||
*
|
||||
* @param frame
|
||||
* @param frame_pointer
|
||||
* @param env
|
||||
* @return struct cons_pointer a pointer to a real
|
||||
*/
|
||||
// struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
// struct cons_pointer env )
|
||||
struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer rat = frame->arg[0];
|
||||
|
||||
debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
|
||||
debug_print_object( rat, DEBUG_ARITH);
|
||||
|
||||
if ( ratiop( rat)) {
|
||||
result = make_real( c_ratio_to_ld( rat));
|
||||
} // TODO: else throw an exception?
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -75,4 +75,7 @@ struct cons_pointer
|
|||
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env);
|
||||
|
||||
#endif /* PEANO_H */
|
||||
|
|
|
|||
|
|
@ -11,15 +11,17 @@
|
|||
#include <math.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#include "arith/integer.h"
|
||||
#include "arith/peano.h"
|
||||
#include "arith/ratio.h"
|
||||
#include "arith/real.h"
|
||||
#include "debug.h"
|
||||
#include "io/print.h"
|
||||
#include "memory/conspage.h"
|
||||
#include "memory/consspaceobject.h"
|
||||
#include "debug.h"
|
||||
#include "memory/stack.h"
|
||||
#include "ops/equal.h"
|
||||
#include "arith/integer.h"
|
||||
#include "ops/lispops.h"
|
||||
#include "arith/peano.h"
|
||||
#include "io/print.h"
|
||||
#include "arith/ratio.h"
|
||||
|
||||
|
||||
/**
|
||||
|
|
@ -91,11 +93,10 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
|
|||
struct cons_pointer arg2 ) {
|
||||
struct cons_pointer r, result;
|
||||
|
||||
debug_print( L"add_ratio_ratio( arg1 = ", DEBUG_ARITH );
|
||||
debug_print( L"\naadd_ratio_ratio: ", DEBUG_ARITH);
|
||||
debug_print_object( arg1, DEBUG_ARITH);
|
||||
debug_print( L"; arg2 = ", DEBUG_ARITH );
|
||||
debug_print( L" + ", DEBUG_ARITH);
|
||||
debug_print_object( arg2, DEBUG_ARITH);
|
||||
debug_print( L")\n", DEBUG_ARITH );
|
||||
|
||||
if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
|
||||
struct cons_space_object cell1 = pointer2cell( arg1 );
|
||||
|
|
@ -111,7 +112,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
|
|||
lcm = least_common_multiple( dr1v, dr2v ),
|
||||
m1 = lcm / dr1v, m2 = lcm / dr2v;
|
||||
|
||||
debug_printf( DEBUG_ARITH, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm,
|
||||
debug_printf( DEBUG_ARITH, L"; lcm = %ld; m1 = %ld; m2 = %ld", lcm,
|
||||
m1, m2 );
|
||||
|
||||
if ( dr1v == dr2v ) {
|
||||
|
|
@ -170,6 +171,11 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
|
|||
struct cons_pointer ratarg ) {
|
||||
struct cons_pointer result;
|
||||
|
||||
debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH);
|
||||
debug_print_object( intarg, DEBUG_ARITH);
|
||||
debug_print( L" + ", DEBUG_ARITH);
|
||||
debug_print_object( ratarg, DEBUG_ARITH);
|
||||
|
||||
if ( integerp( intarg ) && ratiop( ratarg ) ) {
|
||||
// TODO: not longer works
|
||||
struct cons_pointer one = acquire_integer( 1, NIL ),
|
||||
|
|
@ -188,6 +194,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
|
|||
NIL ) ) ), NIL );
|
||||
}
|
||||
|
||||
debug_print( L" => ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -199,6 +209,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
|
|||
*/
|
||||
struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
|
||||
struct cons_pointer arg2 ) {
|
||||
debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH);
|
||||
debug_print_object( arg1, DEBUG_ARITH);
|
||||
debug_print( L" / ", DEBUG_ARITH);
|
||||
debug_print_object( arg2, DEBUG_ARITH);
|
||||
// TODO: this now has to work if `arg1` is an integer
|
||||
struct cons_pointer i =
|
||||
make_ratio( pointer2cell( arg2 ).payload.ratio.divisor,
|
||||
|
|
@ -207,6 +221,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
|
|||
|
||||
dec_ref( i );
|
||||
|
||||
debug_print( L" => ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -259,6 +277,10 @@ struct cons_pointer multiply_ratio_ratio( struct
|
|||
NIL );
|
||||
}
|
||||
|
||||
debug_print( L" => ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -272,6 +294,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
|
|||
struct cons_pointer ratarg ) {
|
||||
struct cons_pointer result;
|
||||
|
||||
debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH);
|
||||
debug_print_object( intarg, DEBUG_ARITH);
|
||||
debug_print( L" * ", DEBUG_ARITH);
|
||||
debug_print_object( ratarg, DEBUG_ARITH);
|
||||
|
||||
if ( integerp( intarg ) && ratiop( ratarg ) ) {
|
||||
// TODO: no longer works; fix
|
||||
struct cons_pointer one = acquire_integer( 1, NIL ),
|
||||
|
|
@ -286,6 +313,10 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
|
|||
NIL );
|
||||
}
|
||||
|
||||
debug_print( L" => ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -298,6 +329,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
|
|||
*/
|
||||
struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
|
||||
struct cons_pointer arg2 ) {
|
||||
debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH);
|
||||
debug_print_object( arg1, DEBUG_ARITH);
|
||||
debug_print( L" * ", DEBUG_ARITH);
|
||||
debug_print_object( arg2, DEBUG_ARITH);
|
||||
|
||||
struct cons_pointer i = negative( arg2 ),
|
||||
result = add_ratio_ratio( arg1, i );
|
||||
|
||||
|
|
@ -361,3 +397,35 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
|
|||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief convert a ratio to an equivalent long double.
|
||||
*
|
||||
* @param rat a pointer to a ratio.
|
||||
* @return long double
|
||||
*/
|
||||
long double c_ratio_to_ld( struct cons_pointer rat) {
|
||||
long double result = NAN;
|
||||
|
||||
debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
|
||||
debug_print_object( rat, DEBUG_ARITH);
|
||||
|
||||
if ( ratiop( rat)) {
|
||||
struct cons_space_object * cell_a = & pointer2cell( rat);
|
||||
struct cons_pointer dv = cell_a->payload.ratio.divisor;
|
||||
struct cons_space_object * dv_cell = &pointer2cell( dv);
|
||||
struct cons_pointer dd = cell_a->payload.ratio.dividend;
|
||||
struct cons_space_object * dd_cell = &pointer2cell( dd);
|
||||
|
||||
if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
|
||||
result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);;
|
||||
} else {
|
||||
fwprintf( stderr, L"real conversion is not yet implemented for bignums rationals.");
|
||||
}
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ARITH, L"\nc_ratio_to_ld returning %d\n", result );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -36,4 +36,6 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
|
|||
|
||||
bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );
|
||||
|
||||
long double c_ratio_to_ld( struct cons_pointer rat);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@
|
|||
/* libcurl, used for io */
|
||||
#include <curl/curl.h>
|
||||
|
||||
#include "arith/ratio.h"
|
||||
#include "version.h"
|
||||
#include "memory/conspage.h"
|
||||
#include "memory/consspaceobject.h"
|
||||
|
|
@ -347,6 +348,7 @@ int main( int argc, char *argv[] ) {
|
|||
bind_function( L"print", &lisp_print );
|
||||
bind_function( L"put!", lisp_hashmap_put );
|
||||
bind_function( L"put-all!", &lisp_hashmap_put_all );
|
||||
bind_function( L"ratio->real", &lisp_ratio_to_real );
|
||||
bind_function( L"read", &lisp_read );
|
||||
bind_function( L"read-char", &lisp_read_char );
|
||||
bind_function( L"repl", &lisp_repl );
|
||||
|
|
|
|||
|
|
@ -51,11 +51,11 @@ bool end_of_string( struct cons_pointer string ) {
|
|||
|
||||
/**
|
||||
* @brief compare two long doubles and returns true if they are the same to
|
||||
* within a tolerance of one part in a million.
|
||||
* within a tolerance of one part in a billion.
|
||||
*
|
||||
* @param a
|
||||
* @param b
|
||||
* @return true if `a` and `b` are equal to within one part in a million.
|
||||
* @return true if `a` and `b` are equal to within one part in a billion.
|
||||
* @return false otherwise.
|
||||
*/
|
||||
bool equal_ld_ld( long double a, long double b) {
|
||||
|
|
@ -66,7 +66,7 @@ bool equal_ld_ld( long double a, long double b) {
|
|||
/* average magnitude of the two */
|
||||
long double av = (fa > fb) ? ( fa - diff) : ( fb - diff);
|
||||
/* amount of difference we will tolerate for equality */
|
||||
long double tolerance = av * 0.0000001;
|
||||
long double tolerance = av * 0.000000001;
|
||||
|
||||
bool result = ( fabsl( a - b) < tolerance);
|
||||
|
||||
|
|
@ -164,20 +164,9 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
|
|||
result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value);
|
||||
}
|
||||
break;
|
||||
case RATIOTV: {
|
||||
case RATIOTV:
|
||||
struct cons_space_object * cell_a = & pointer2cell( a);
|
||||
struct cons_pointer dv = cell_a->payload.ratio.divisor;
|
||||
struct cons_space_object * dv_cell = &pointer2cell( dv);
|
||||
struct cons_pointer dd = cell_a->payload.ratio.dividend;
|
||||
struct cons_space_object * dd_cell = &pointer2cell( dd);
|
||||
|
||||
if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
|
||||
long double bv = ((long double) dv_cell->payload.integer.value) / ((long double) dd_cell->payload.integer.value);
|
||||
result = equal_ld_ld( bv, cell_a->payload.real.value);
|
||||
} else {
|
||||
fwprintf( stderr, L"\nequality is not yet implemented for bignums rationals compared to reals.");
|
||||
}
|
||||
}
|
||||
result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value);
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue