r23712 - gnucash/trunk/src/report/standard-reports - Advanced Portfolio: Eliminate all overflow problems.
Mike Alexander
mta at code.gnucash.org
Sun Jan 19 02:09:13 EST 2014
Author: mta
Date: 2014-01-19 02:09:13 -0500 (Sun, 19 Jan 2014)
New Revision: 23712
Trac: http://svn.gnucash.org/trac/changeset/23712
Modified:
gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
Log:
Advanced Portfolio: Eliminate all overflow problems.
Share and price calculations are done to 5 decimal places and currency
calculations are done using the precision defined for the currency.
Modified: gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm 2014-01-19 07:09:06 UTC (rev 23711)
+++ gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm 2014-01-19 07:09:13 UTC (rev 23712)
@@ -48,6 +48,10 @@
(define optname-prefer-pricelist (N_ "Set preference for price list data"))
(define optname-ignore-brokerage-fees (N_ "Ignore brokerage fees when calculating returns"))
+;; To avoid overflows in our calculations, define a denominator for prices and unit values
+(define price-denom 100000)
+(define units-denom 100000)
+
(define (options-generator)
(let* ((options (gnc:new-options))
;; This is just a helper function for making options.
@@ -194,10 +198,10 @@
(equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
;; sum up the contents of the b-list built by basis-builder below
- (define (sum-basis b-list)
+ (define (sum-basis b-list currency-frac)
(if (not (eqv? b-list '()))
- (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-ROUND))
- (sum-basis (cdr b-list)) 100 GNC-RND-ROUND)
+ (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)
+ (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)
(gnc-numeric-zero)
)
)
@@ -206,7 +210,7 @@
(define (units-basis b-list)
(if (not (eqv? b-list '()))
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
- 100 GNC-RND-ROUND)
+ units-denom GNC-RND-ROUND)
(gnc-numeric-zero)
)
)
@@ -215,8 +219,8 @@
;; I need to get a brain and use (map) for this.
(define (apply-basis-ratio b-list units-ratio value-ratio)
(if (not (eqv? b-list '()))
- (cons (cons (gnc-numeric-mul units-ratio (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
- (gnc-numeric-mul value-ratio (cdar b-list) GNC-DENOM-AUTO GNC-RND-ROUND))
+ (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)
+ (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
(apply-basis-ratio (cdr b-list) units-ratio value-ratio))
'()
)
@@ -226,7 +230,7 @@
;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one
;; cell that mutates to the new average. Need to add a date checker so that we allow for prices
;; coming in out of order, such as a transfer with a price adjusted to carryover the basis.
- (define (basis-builder b-list b-units b-value b-method)
+ (define (basis-builder b-list b-units b-value b-method currency-frac)
(gnc:debug "actually in basis-builder")
(gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
" b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)
@@ -241,22 +245,22 @@
((average-basis)
(if (not (eqv? b-list '()))
(list (cons (gnc-numeric-add b-units
- (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
+ (caar b-list) units-denom GNC-RND-ROUND)
(gnc-numeric-div
(gnc-numeric-add b-value
(gnc-numeric-mul (caar b-list)
(cdar b-list)
- GNC-DENOM-AUTO GNC-RND-ROUND)
- GNC-DENOM-AUTO GNC-RND-ROUND)
+ price-denom GNC-RND-ROUND)
+ price-denom GNC-RND-ROUND)
(gnc-numeric-add b-units
- (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
- GNC-DENOM-AUTO GNC-RND-ROUND)))
+ (caar b-list) price-denom GNC-RND-ROUND)
+ price-denom GNC-RND-ROUND)))
(append b-list
(list (cons b-units (gnc-numeric-div
- b-value b-units GNC-DENOM-AUTO GNC-RND-ROUND))))))
+ b-value b-units price-denom GNC-RND-ROUND))))))
(else (append b-list
(list (cons b-units (gnc-numeric-div
- b-value b-units GNC-DENOM-AUTO GNC-RND-ROUND)))))))
+ b-value b-units price-denom GNC-RND-ROUND)))))))
;; we have value and negative units, remove units from basis
((and (not (gnc-numeric-zero-p b-value))
@@ -268,11 +272,11 @@
(gnc-numeric-abs b-units) (caar b-list))))
(basis-builder (cdr b-list) (gnc-numeric-add
b-units
- (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
- b-value b-method)
+ (caar b-list) units-denom GNC-RND-ROUND)
+ b-value b-method currency-frac)
(append (list (cons (gnc-numeric-add
b-units
- (caar b-list) GNC-DENOM-AUTO GNC-RND-ROUND)
+ (caar b-list) units-denom GNC-RND-ROUND)
(cdar b-list))) (cdr b-list))))
((filo-basis)
(if (not (= -1 (gnc-numeric-compare
@@ -281,16 +285,16 @@
(gnc-numeric-add
b-units
(caar (reverse b-list))
- GNC-DENOM-AUTO GNC-RND-ROUND)
- b-value b-method)
+ units-denom GNC-RND-ROUND)
+ b-value b-method currency-frac)
(append (cdr (reverse b-list))
(list (cons (gnc-numeric-add
b-units
- (caar (reverse b-list)) GNC-DENOM-AUTO GNC-RND-ROUND)
+ (caar (reverse b-list)) units-denom GNC-RND-ROUND)
(cdar (reverse b-list)))))))
((average-basis)
(list (cons (gnc-numeric-add
- (caar b-list) b-units GNC-DENOM-AUTO GNC-RND-ROUND)
+ (caar b-list) b-units units-denom GNC-RND-ROUND)
(cdar b-list)))))
'()
))
@@ -315,7 +319,7 @@
;; with a ratio of 1
((and (gnc-numeric-zero-p b-units)
(not (gnc-numeric-zero-p b-value)))
- (let* ((current-value (sum-basis b-list))
+ (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
(value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-RND-ROUND)
current-value GNC-DENOM-AUTO GNC-RND-ROUND)))
@@ -380,6 +384,7 @@
;; arbitrarily set the commod-currency to the same as
;; that of the report's currency
(commod-currency (if price (gnc-price-get-currency price) currency))
+ (commod-currency-frac (gnc-commodity-get-fraction commod-currency))
;; the value of the commodity, expressed in terms of
;; the report's currency.
(value (exchange-fn (gnc:make-gnc-monetary commodity units) currency))
@@ -420,6 +425,7 @@
(begin
;; we're using a transaction to get the price, so we have to set some stuff
(set! commod-currency (xaccAccountGetCommodity (xaccSplitGetAccount s)))
+ (set! commod-currency-frac (gnc-commodity-get-fraction commod-currency))
;; FIX-ME this doesn't set a pricing-txn
;; if there is a price list which leads
;; to a swigification crash if the user
@@ -528,7 +534,7 @@
((split-account-type? x ACCT-TYPE-EXPENSE)
(begin
(set! adjusted-dividend (gnc-numeric-sub dividend-income (xaccSplitGetValue x)
- GNC-DENOM-AUTO GNC-RND-ROUND))
+ commod-currency-frac GNC-RND-ROUND))
(gnc:debug "adjusting adjusted-dividend by " (gnc-numeric-to-string dividend-income))
;; grab the brokerage that
;; may be associated so we
@@ -552,7 +558,7 @@
(brokeragecoll 'add commod-currency
(gnc-numeric-mul split-brokerage
split-ratio
- 100 GNC-RND-ROUND))
+ commod-currency-frac GNC-RND-ROUND))
(if (gnc-numeric-zero-p dividend-rein)
(begin
@@ -568,7 +574,7 @@
;; collector
(let ((div (gnc-numeric-mul dividend-income
split-ratio
- 100 GNC-RND-ROUND)))
+ commod-currency-frac GNC-RND-ROUND)))
(gnc:debug "Adjusted dividend " (gnc-numeric-to-string div))
div)
)
@@ -590,7 +596,9 @@
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary
commod-currency split-value)
- currency)) basis-method))
+ currency))
+ basis-method
+ commod-currency-frac))
(gnc:debug "coming out of basis list " basis-list)
;; adjust moneyin/out
@@ -617,7 +625,8 @@
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary
commod-currency split-value)
- currency)) basis-method))
+ currency)) basis-method
+ commod-currency-frac))
(gnc:debug "after spin-off basis list " basis-list)
)
)
@@ -653,13 +662,13 @@
(gnc:make-gnc-monetary commod-currency
(gnc-numeric-div txn-value
(gnc-numeric-abs txn-units)
- 100 GNC-RND-ROUND))
+ commod-currency-frac GNC-RND-ROUND))
(gnc:make-gnc-monetary commod-currency (gnc-numeric-zero))))
(set! value (if price (gnc:make-gnc-monetary commod-currency
(gnc-numeric-mul units
(gnc:gnc-monetary-amount price)
- 100 GNC-RND-ROUND))
+ commod-currency-frac GNC-RND-ROUND))
(gnc:make-gnc-monetary commod-currency (gnc-numeric-zero))))
(set! warn-price-dirty #t)
)
@@ -667,8 +676,9 @@
;; what this means is gain = moneyout - moneyin + basis-of-current-shares, and
;; adjust for brokers and dividends.
- (gaincoll 'add currency (sum-basis basis-list))
- (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list)))
+ (gaincoll 'add currency (sum-basis basis-list (gnc-commodity-get-fraction currency)))
+ (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
+ (gnc-commodity-get-fraction currency))))
(gnc:debug "but the actual basis list is " basis-list)
(gaincoll 'merge moneyoutcoll #f)
@@ -689,18 +699,18 @@
(gain (gnc:sum-collector-commodity gaincoll currency exchange-fn))
(ugain (gnc:make-gnc-monetary currency
(gnc-numeric-sub (gnc:gnc-monetary-amount (exchange-fn value currency))
- (sum-basis basis-list)
- 100 GNC-RND-ROUND)))
+ (sum-basis basis-list (gnc-commodity-get-fraction currency))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
(gnc:gnc-monetary-amount ugain)
- 100 GNC-RND-ROUND)))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain)
(if ignore-brokerage-fees
(gnc:gnc-monetary-amount income)
(gnc-numeric-sub (gnc:gnc-monetary-amount income)
(gnc:gnc-monetary-amount brokerage)
- 100 GNC-RND-ROUND))
- 100 GNC-RND-ROUND)))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(activecols (list (gnc:html-account-anchor current)))
)
@@ -712,7 +722,7 @@
(total-income 'merge dividendcoll #f)
(total-gain 'merge gaincoll #f)
(total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain))
- (total-basis 'add currency (sum-basis basis-list))
+ (total-basis 'add currency (sum-basis basis-list (gnc-commodity-get-fraction currency)))
;; build a list for the row based on user selections
(if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol))))
@@ -734,7 +744,8 @@
)))))
(append! activecols (list (if use-txn "*" " ")
(gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list)))
+ "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
+ (gnc-commodity-get-fraction currency))))
(gnc:make-html-table-header-cell/markup "number-cell" value)
(gnc:make-html-table-header-cell/markup "number-cell" moneyin)
(gnc:make-html-table-header-cell/markup "number-cell" moneyout)
@@ -911,15 +922,15 @@
(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)
(gnc:gnc-monetary-amount sum-total-ugain)
- 100 GNC-RND-ROUND)))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn))
(set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-both-gains)
(if ignore-brokerage-fees
(gnc:gnc-monetary-amount sum-total-income)
(gnc-numeric-sub (gnc:gnc-monetary-amount sum-total-income)
(gnc:gnc-monetary-amount sum-total-brokerage)
- 100 GNC-RND-ROUND))
- 100 GNC-RND-ROUND)))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND))
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(gnc:html-table-append-row/markup!
table
More information about the gnucash-changes
mailing list