mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[advanced-portfolio] move helper functions to toplevel for testing
functions are moved to toplevel advanced-portfolio.scm. this allows them to be tested.
This commit is contained in:
Christopher Lam
parent
fb9cde3684
commit
64637f72cf
@ -179,6 +179,158 @@ by preventing negative stock balances.<br/>")
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
options))
|
||||
|
||||
;; helper functions for renderer
|
||||
|
||||
;; sum up the contents of the b-list built by basis-builder below
|
||||
(define (sum-basis b-list currency-frac)
|
||||
(if (not (eqv? b-list '()))
|
||||
(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)))
|
||||
|
||||
;; sum up the total number of units in the b-list built by
|
||||
;; basis-builder below
|
||||
(define (units-basis b-list)
|
||||
(if (not (eqv? b-list '()))
|
||||
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
|
||||
units-denom GNC-RND-ROUND)
|
||||
(gnc-numeric-zero)))
|
||||
|
||||
;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
|
||||
;; 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) 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))
|
||||
'()))
|
||||
|
||||
;; this builds a list for basis calculation and handles average, fifo
|
||||
;; and lifo methods 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 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)
|
||||
|
||||
;; if there is no b-value, then this is a split/merger and needs
|
||||
;; special handling
|
||||
(cond
|
||||
|
||||
;; we have value and positive units, add units to basis
|
||||
((and (not (gnc-numeric-zero-p b-value))
|
||||
(gnc-numeric-positive-p b-units))
|
||||
(case b-method
|
||||
((average-basis)
|
||||
(if (not (eqv? b-list '()))
|
||||
(list (cons (gnc-numeric-add b-units
|
||||
(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-DENOM-REDUCE)
|
||||
GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
(let ((denom (gnc-numeric-add b-units
|
||||
(caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
|
||||
(if (zero? denom)
|
||||
(throw 'div/0 (format #f "buying ~0,4f share units" b-units))
|
||||
denom))
|
||||
price-denom GNC-RND-ROUND)))
|
||||
(append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
b-value b-units price-denom GNC-RND-ROUND))))))
|
||||
(else (append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
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))
|
||||
(gnc-numeric-negative-p b-units))
|
||||
(if (not (eqv? b-list '()))
|
||||
(case b-method
|
||||
((fifo-basis)
|
||||
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
|
||||
((-1)
|
||||
;; Sold less than the first lot, create a new first lot
|
||||
;; from the remainder
|
||||
(let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)))
|
||||
(cons (cons new-units (cdar b-list)) (cdr b-list))))
|
||||
((0)
|
||||
;; Sold all of the first lot
|
||||
(cdr b-list))
|
||||
((1)
|
||||
;; Sold more than the first lot, delete it and recurse
|
||||
(basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
|
||||
;; Only the sign of b-value matters since
|
||||
;; the new b-units is negative
|
||||
b-value
|
||||
b-method currency-frac))))
|
||||
((filo-basis)
|
||||
(let ((rev-b-list (reverse b-list)))
|
||||
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
|
||||
((-1)
|
||||
;; Sold less than the last lot
|
||||
(let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)))
|
||||
(reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list)))))
|
||||
((0)
|
||||
;; Sold all of the last lot
|
||||
(reverse (cdr rev-b-list))
|
||||
)
|
||||
((1)
|
||||
;; Sold more than the last lot
|
||||
(basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
|
||||
b-value b-method currency-frac)))))
|
||||
((average-basis)
|
||||
(list (cons (gnc-numeric-add
|
||||
(caar b-list) b-units units-denom GNC-RND-ROUND)
|
||||
(cdar b-list)))))
|
||||
'()))
|
||||
|
||||
;; no value, just units, this is a split/merge...
|
||||
((and (gnc-numeric-zero-p b-value)
|
||||
(not (gnc-numeric-zero-p b-units)))
|
||||
(let* ((current-units (units-basis b-list))
|
||||
;; If current-units is zero then so should be everything else.
|
||||
(units-ratio (if (zero? current-units) (gnc-numeric-zero)
|
||||
(gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
|
||||
;; If the units ratio is zero the stock is worthless and
|
||||
;; the value should be zero too
|
||||
(value-ratio (if (gnc-numeric-zero-p units-ratio)
|
||||
(gnc-numeric-zero)
|
||||
(gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
|
||||
|
||||
(gnc:debug "blist is " b-list " current units is "
|
||||
(gnc-numeric-to-string current-units)
|
||||
" value ratio is " (gnc-numeric-to-string value-ratio)
|
||||
" units ratio is " (gnc-numeric-to-string units-ratio))
|
||||
(apply-basis-ratio b-list units-ratio value-ratio)))
|
||||
|
||||
;; If there are no units, just a value, then its a spin-off,
|
||||
;; calculate a ratio for the values, but leave the units alone
|
||||
;; 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 GNC-DENOM-AUTO))
|
||||
(value-ratio (if (zero? current-value)
|
||||
(throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
|
||||
(gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
|
||||
|
||||
(gnc:debug "this is a spinoff")
|
||||
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
|
||||
(apply-basis-ratio b-list 1/1 value-ratio)))
|
||||
|
||||
;; when all else fails, just send the b-list back
|
||||
(else
|
||||
b-list)))
|
||||
|
||||
|
||||
|
||||
;; This is the rendering function. It accepts a database of options
|
||||
;; and generates an object of type <html-document>. See the file
|
||||
;; report-html.txt for documentation; the file report-html.scm
|
||||
@ -209,158 +361,6 @@ by preventing negative stock balances.<br/>")
|
||||
(define (same-account? a1 a2)
|
||||
(equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
|
||||
|
||||
;; sum up the contents of the b-list built by basis-builder below
|
||||
(define (sum-basis b-list currency-frac)
|
||||
(if (not (eqv? b-list '()))
|
||||
(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)
|
||||
)
|
||||
)
|
||||
|
||||
;; sum up the total number of units in the b-list built by basis-builder below
|
||||
(define (units-basis b-list)
|
||||
(if (not (eqv? b-list '()))
|
||||
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
|
||||
units-denom GNC-RND-ROUND)
|
||||
(gnc-numeric-zero)
|
||||
)
|
||||
)
|
||||
|
||||
;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
|
||||
;; 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) 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))
|
||||
'()
|
||||
)
|
||||
)
|
||||
|
||||
;; this builds a list for basis calculation and handles average, fifo and lifo methods
|
||||
;; 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 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)
|
||||
|
||||
;; if there is no b-value, then this is a split/merger and needs special handling
|
||||
(cond
|
||||
|
||||
;; we have value and positive units, add units to basis
|
||||
((and (not (gnc-numeric-zero-p b-value))
|
||||
(gnc-numeric-positive-p b-units))
|
||||
(case b-method
|
||||
((average-basis)
|
||||
(if (not (eqv? b-list '()))
|
||||
(list (cons (gnc-numeric-add b-units
|
||||
(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-DENOM-REDUCE)
|
||||
GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
(let ((denom (gnc-numeric-add b-units
|
||||
(caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
|
||||
(if (zero? denom)
|
||||
(throw 'div/0 (format #f "buying ~0,4f share units" b-units))
|
||||
denom))
|
||||
price-denom GNC-RND-ROUND)))
|
||||
(append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
b-value b-units price-denom GNC-RND-ROUND))))))
|
||||
(else (append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
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))
|
||||
(gnc-numeric-negative-p b-units))
|
||||
(if (not (eqv? b-list '()))
|
||||
(case b-method
|
||||
((fifo-basis)
|
||||
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
|
||||
((-1)
|
||||
;; Sold less than the first lot, create a new first lot from the remainder
|
||||
(let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)))
|
||||
(cons (cons new-units (cdar b-list)) (cdr b-list))))
|
||||
((0)
|
||||
;; Sold all of the first lot
|
||||
(cdr b-list))
|
||||
((1)
|
||||
;; Sold more than the first lot, delete it and recurse
|
||||
(basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
|
||||
b-value ;; Only the sign of b-value matters since the new b-units is negative
|
||||
b-method currency-frac))))
|
||||
((filo-basis)
|
||||
(let ((rev-b-list (reverse b-list)))
|
||||
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
|
||||
((-1)
|
||||
;; Sold less than the last lot
|
||||
(let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)))
|
||||
(reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list)))))
|
||||
((0)
|
||||
;; Sold all of the last lot
|
||||
(reverse (cdr rev-b-list))
|
||||
)
|
||||
((1)
|
||||
;; Sold more than the last lot
|
||||
(basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
|
||||
b-value b-method currency-frac)
|
||||
))))
|
||||
((average-basis)
|
||||
(list (cons (gnc-numeric-add
|
||||
(caar b-list) b-units units-denom GNC-RND-ROUND)
|
||||
(cdar b-list)))))
|
||||
'()
|
||||
))
|
||||
|
||||
;; no value, just units, this is a split/merge...
|
||||
((and (gnc-numeric-zero-p b-value)
|
||||
(not (gnc-numeric-zero-p b-units)))
|
||||
(let* ((current-units (units-basis b-list))
|
||||
;; If current-units is zero then so should be everything else.
|
||||
(units-ratio (if (zero? current-units) (gnc-numeric-zero)
|
||||
(gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
|
||||
;; If the units ratio is zero the stock is worthless and the value should be zero too
|
||||
(value-ratio (if (gnc-numeric-zero-p units-ratio)
|
||||
(gnc-numeric-zero)
|
||||
(gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
|
||||
|
||||
(gnc:debug "blist is " b-list " current units is "
|
||||
(gnc-numeric-to-string current-units)
|
||||
" value ratio is " (gnc-numeric-to-string value-ratio)
|
||||
" units ratio is " (gnc-numeric-to-string units-ratio))
|
||||
(apply-basis-ratio b-list units-ratio value-ratio)
|
||||
))
|
||||
|
||||
;; If there are no units, just a value, then its a spin-off,
|
||||
;; calculate a ratio for the values, but leave the units alone
|
||||
;; 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 GNC-DENOM-AUTO))
|
||||
(value-ratio (if (zero? current-value)
|
||||
(throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
|
||||
(gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
|
||||
|
||||
(gnc:debug "this is a spinoff")
|
||||
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
|
||||
(apply-basis-ratio b-list 1/1 value-ratio))
|
||||
)
|
||||
|
||||
;; when all else fails, just send the b-list back
|
||||
(else
|
||||
b-list)
|
||||
)
|
||||
)
|
||||
|
||||
;; Given a price list and a currency find the price for that currency on the list.
|
||||
;; If there is none for the requested currency, return the first one.
|
||||
;; The price list is released but the price returned is ref counted.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user