another stab at improving rounding. prevent more overflows as pointed out by Kendall Green.

lots of GNC-AUTO-DENOM seems to clean up the overflowing and prevent phantom gains/losses from rounding errors.
BP



git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@16759 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Andrew Sackville-West 2007-12-29 00:25:36 +00:00
parent c510e32a55
commit 945975bc50

View File

@ -197,7 +197,7 @@
;; sum up the contents of the b-list built by basis-builder below ;; sum up the contents of the b-list built by basis-builder below
(define (sum-basis b-list) (define (sum-basis b-list)
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) 100 GNC-RND-ROUND) (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
(sum-basis (cdr b-list)) 100 GNC-RND-ROUND) (sum-basis (cdr b-list)) 100 GNC-RND-ROUND)
(gnc-numeric-zero) (gnc-numeric-zero)
) )
@ -207,7 +207,7 @@
(define (units-basis b-list) (define (units-basis b-list)
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) (gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER)) 100 GNC-RND-ROUND)
(gnc-numeric-zero) (gnc-numeric-zero)
) )
) )
@ -216,8 +216,8 @@
;; I need to get a brain and use (map) for this. ;; I need to get a brain and use (map) for this.
(define (apply-basis-ratio b-list units-ratio value-ratio) (define (apply-basis-ratio b-list units-ratio value-ratio)
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(cons (cons (gnc-numeric-mul units-ratio (caar b-list) 100000 GNC-RND-ROUND) (cons (cons (gnc-numeric-mul units-ratio (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
(gnc-numeric-mul value-ratio (cdar b-list) 100000 GNC-RND-ROUND)) (gnc-numeric-mul value-ratio (cdar b-list) GNC-DENOM-AUTO GNC-RND-ROUND))
(apply-basis-ratio (cdr b-list) units-ratio value-ratio)) (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
'() '()
) )
@ -241,22 +241,22 @@
((average-basis) ((average-basis)
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(list (cons (gnc-numeric-add b-units (list (cons (gnc-numeric-add b-units
(caar b-list) 10000 GNC-RND-ROUND) (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
(gnc-numeric-div (gnc-numeric-div
(gnc-numeric-add b-value (gnc-numeric-add b-value
(gnc-numeric-mul (caar b-list) (gnc-numeric-mul (caar b-list)
(cdar b-list) (cdar b-list)
10000 GNC-RND-ROUND) GNC-DENOM-AUTO GNC-RND-ROUND)
10000 GNC-RND-ROUND) GNC-DENOM-AUTO GNC-RND-ROUND)
(gnc-numeric-add b-units (gnc-numeric-add b-units
(caar b-list) 10000 GNC-RND-ROUND) (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
10000 GNC-RND-ROUND))) GNC-DENOM-AUTO GNC-RND-ROUND)))
(append b-list (append b-list
(list (cons b-units (gnc-numeric-div (list (cons b-units (gnc-numeric-div
b-value b-units 10000 GNC-RND-ROUND)))))) b-value b-units GNC-DENOM-AUTO GNC-RND-ROUND))))))
(else (append b-list (else (append b-list
(list (cons b-units (gnc-numeric-div (list (cons b-units (gnc-numeric-div
b-value b-units 10000 GNC-RND-ROUND))))))) b-value b-units GNC-DENOM-AUTO GNC-RND-ROUND)))))))
;; we have value and negative units, remove units from basis ;; we have value and negative units, remove units from basis
((and (not (gnc-numeric-zero-p b-value)) ((and (not (gnc-numeric-zero-p b-value))
@ -268,11 +268,11 @@
(gnc-numeric-abs b-units) (caar b-list)))) (gnc-numeric-abs b-units) (caar b-list))))
(basis-builder (cdr b-list) (gnc-numeric-add (basis-builder (cdr b-list) (gnc-numeric-add
b-units b-units
(caar b-list) 10000 GNC-RND-ROUND) (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
b-value b-method) b-value b-method)
(append (list (cons (gnc-numeric-add (append (list (cons (gnc-numeric-add
b-units b-units
(caar b-list) 10000 GNC-RND-ROUND) (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
(cdar b-list))) (cdr b-list)))) (cdar b-list))) (cdr b-list))))
((filo-basis) ((filo-basis)
(if (not (= -1 (gnc-numeric-compare (if (not (= -1 (gnc-numeric-compare
@ -281,16 +281,16 @@
(gnc-numeric-add (gnc-numeric-add
b-units b-units
(caar (reverse b-list)) (caar (reverse b-list))
10000 GNC-RND-ROUND) GNC-DENOM-AUTO GNC-RND-ROUND)
b-value b-method) b-value b-method)
(append (cdr (reverse b-list)) (append (cdr (reverse b-list))
(list (cons (gnc-numeric-add (list (cons (gnc-numeric-add
b-units b-units
(caar (reverse b-list)) 10000 GNC-RND-ROUND) (caar (reverse b-list)) GNC-DENOM-AUTO GNC-RND-ROUND)
(cdar (reverse b-list))))))) (cdar (reverse b-list)))))))
((average-basis) ((average-basis)
(list (cons (gnc-numeric-add (list (cons (gnc-numeric-add
(caar b-list) b-units 10000 GNC-RND-ROUND) (caar b-list) b-units GNC-DENOM-AUTO GNC-RND-ROUND)
(cdar b-list))))) (cdar b-list)))))
'() '()
)) ))
@ -299,11 +299,11 @@
((and (gnc-numeric-zero-p b-value) ((and (gnc-numeric-zero-p b-value)
(not (gnc-numeric-zero-p b-units))) (not (gnc-numeric-zero-p b-units)))
(let* ((current-units (units-basis b-list)) (let* ((current-units (units-basis b-list))
(units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units 100000 GNC-RND-ROUND) (units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-RND-ROUND)
current-units 10000 GNC-RND-ROUND)) current-units GNC-DENOM-AUTO GNC-RND-ROUND))
(value-ratio (gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio 100000 GNC-RND-ROUND))) (value-ratio (gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-RND-ROUND)))
(gnc:debug "blist is " b-list " units ratio is " units-ratio) (gnc:debug "blist is " b-list " current units is " current-units " units ratio is " units-ratio)
(apply-basis-ratio b-list units-ratio value-ratio) (apply-basis-ratio b-list units-ratio value-ratio)
)) ))
@ -313,8 +313,8 @@
((and (gnc-numeric-zero-p b-units) ((and (gnc-numeric-zero-p b-units)
(not (gnc-numeric-zero-p b-value))) (not (gnc-numeric-zero-p b-value)))
(let* ((current-value (sum-basis b-list)) (let* ((current-value (sum-basis b-list))
(value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value 100000 GNC-RND-ROUND) (value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-RND-ROUND)
current-value 100000 GNC-RND-ROUND))) current-value GNC-DENOM-AUTO GNC-RND-ROUND)))
(gnc:debug "this is a spinoff") (gnc:debug "this is a spinoff")
(gnc:debug "blist is " b-list " value ratio is " value-ratio) (gnc:debug "blist is " b-list " value ratio is " value-ratio)
@ -545,13 +545,13 @@
(gnc:make-gnc-monetary commod-currency (gnc:make-gnc-monetary commod-currency
(gnc-numeric-div txn-value (gnc-numeric-div txn-value
(gnc-numeric-abs txn-units) (gnc-numeric-abs txn-units)
100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER))) 100 GNC-RND-ROUND))
(gnc:make-gnc-monetary commod-currency (gnc-numeric-zero)))) (gnc:make-gnc-monetary commod-currency (gnc-numeric-zero))))
(set! value (if price (gnc:make-gnc-monetary commod-currency (set! value (if price (gnc:make-gnc-monetary commod-currency
(gnc-numeric-mul units (gnc-numeric-mul units
(gnc:gnc-monetary-amount price) (gnc:gnc-monetary-amount price)
100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER))) 100 GNC-RND-ROUND))
(gnc:make-gnc-monetary commod-currency (gnc-numeric-zero)))) (gnc:make-gnc-monetary commod-currency (gnc-numeric-zero))))
(set! warn-price-dirty #t) (set! warn-price-dirty #t)
) )
@ -582,10 +582,10 @@
(ugain (gnc:make-gnc-monetary currency (ugain (gnc:make-gnc-monetary currency
(gnc-numeric-sub (gnc:gnc-monetary-amount (exchange-fn value currency)) (gnc-numeric-sub (gnc:gnc-monetary-amount (exchange-fn value currency))
(sum-basis basis-list) (sum-basis basis-list)
100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))) 100 GNC-RND-ROUND)))
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain) (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
(gnc:gnc-monetary-amount ugain) (gnc:gnc-monetary-amount ugain)
100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))) 100 GNC-RND-ROUND)))
(activecols (list (gnc:html-account-anchor current))) (activecols (list (gnc:html-account-anchor current)))
) )
@ -784,7 +784,7 @@
(set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn)) (set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn))
(set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain) (set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain)
(gnc:gnc-monetary-amount sum-total-ugain) (gnc:gnc-monetary-amount sum-total-ugain)
100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))) 100 GNC-RND-ROUND)))
(set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn)) (set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn))
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!