Skip to content

Commit

Permalink
Single functions for gnc:make-exchange-alist and gnc:get-exchange-tot…
Browse files Browse the repository at this point in the history 
…als.

Extract helper functions and add a parameter, eliminating gnc:make-exchange-cost-alist
and gnc:get-exchange-cost-totals.

This makes it more clear the differences between the two algorithms and
makes it easier to correct the algorithm for the cost case.
  • Loading branch information
@jralls
jralls committed Dec 7, 2016
1 parent 0829d6d commit d9dbc3d
Showing 1 changed file with 84 additions and 171 deletions.
255 changes: 84 additions & 171 deletions src/report/report-system/commodity-utilities.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -537,29 +537,58 @@
;; or more runs of gnc:resolve-unknown-comm. Maybe we could transform
;; this functions to use some kind of recursiveness.


;; Calculate the weighted average exchange rate between all
;; commodities and the 'report-commodity'. Uses all currency
;; transactions up until the 'end-date'. Returns an alist, see
;; sumlist.
(define (gnc:get-exchange-totals report-commodity end-date)
(define (create-commodity-list inner-comm outer-comm value-amount share-amount)
(let ((pair (list inner-comm
(cons (gnc:make-numeric-collector)
(gnc:make-numeric-collector)))))
((caadr pair) 'add value-amount)
((cdadr pair) 'add share-amount)
(set comm-list (list outer-comm (list pair)))))

(define (create-foreign-list comm-list transaction-comm account-comm
share-amount value-amount)
(let ((foreign-list
(if (gnc-commodity-equiv transaction-comm (car comm-list))
(list account-comm share-amount value-amount)
(list transaction-comm value-amount share-amount))))
foreign-list))

(define (create-foreign-cost-list comm-list transaction-comm account-comm
share-amount value-amount)
(let ((foreign-list
(if (gnc-commodity-equiv transaction-comm (car comm-list))
(list account-comm share-amount value-amount)
(list transaction-comm (gnc-numeric-neg value-amount)
(gnc-numeric-neg share-amount)))))
foreign-list))

(define (create-commodity-pair foreignlist comm-list sumlist)
(let ((pair (assoc (car foreignlist) (cadr comm-list))))
;; no pair already, create one
(if (not pair)
(set! pair (list (car foreignlist)
(cons (gnc:make-numeric-collector)
(gnc:make-numeric-collector)))))
pair))

;; sumlist: a multilevel alist. Each element has a commodity as key, and another
;; alist as a value. The value-alist's elements consist of a commodity as a key,
;; and a pair of two value-collectors as value, e.g. with only one (the report-)
;; commodity DEM in the outer alist: ( {DEM ( [USD (400 . 1000)] [FRF (300
;; . 100)] ) } ) where DEM,USD,FRF are <gnc:commodity> and the numbers are a
;; numeric-collector which in turn store a <gnc:numeric>. In the example, USD
;; 400 were bought for an amount of DEM 1000, FRF 300 were bought for DEM
;; 100. The reason for the outer alist is that there might be commodity
;; transactions which do not involve the report-commodity, but which can still
;; be calculated after *all* transactions are processed. Calculate the weighted
;; average exchange rate between all commodities and the
;; 'report-commodity'. Uses all currency transactions up until the
;; 'end-date'. Returns an alist, see sumlist.
(define (gnc:get-exchange-totals report-commodity end-date cost)
(let ((curr-accounts
;;(filter gnc:account-has-shares? ))
;; -- use all accounts, not only share accounts, since gnucash-1.7
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
;; sumlist: a multilevel alist. Each element has a commodity
;; as key, and another alist as a value. The value-alist's
;; elements consist of a commodity as a key, and a pair of two
;; value-collectors as value, e.g. with only one (the report-)
;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
;; <gnc:commodity> and the numbers are a numeric-collector
;; which in turn store a <gnc:numeric>. In the example, USD
;; 400 were bought for an amount of DEM 1000, FRF 300 were
;; bought for DEM 100. The reason for the outer alist is that
;; there might be commodity transactions which do not involve
;; the report-commodity, but which can still be calculated
;; after *all* transactions are processed.
(sumlist (list (list report-commodity '()))))

(if (not (null? curr-accounts))
Expand All @@ -571,159 +600,47 @@
(xaccSplitGetParent a)))
(account-comm (xaccAccountGetCommodity
(xaccSplitGetAccount a)))
;; Always use the absolute value here.
(share-amount (gnc-numeric-abs
(xaccSplitGetAmount a)))
(value-amount (gnc-numeric-abs
(xaccSplitGetValue a)))
(share-amount (if cost
(xaccSplitGetAmount a)
(gnc-numeric-abs (xaccSplitGetAmount a))))
(value-amount (if cost
(xaccSplitGetValue a)
(gnc-numeric-abs (xaccSplitGetValue a))))
(tmp (assoc transaction-comm sumlist))
(comm-list (if (not tmp)
(assoc account-comm sumlist)
tmp)))

;; entry exists already in comm-list?
(if (not comm-list)
;; entry doesn't exist in comm-list
;; create sub-alist from scratch
(let ((pair (list transaction-comm
(cons (gnc:make-numeric-collector)
(gnc:make-numeric-collector)))))
((caadr pair) 'add value-amount)
((cdadr pair) 'add share-amount)
(set! comm-list (list account-comm (list pair)))
;; and add the new sub-alist to sumlist.
;; no, create sub-alist from scratch
(begin
(set! comm-list (create-commodity-list
account-comm transaction-comm
share-amount value-amount))

This comment has been minimized.

Sign in to view

Copy link
@christopherlam

christopherlam Feb 14, 2018

Contributor

I assume this is a glaring error - (define create-commodity-list inner-comm outer-comm value-amount share-amount)
share and value were wrongly interchanged???
(set! sumlist (cons comm-list sumlist)))

(let*
;; Put the amounts in the right place.
((foreignlist
(if (gnc-commodity-equiv transaction-comm
(car comm-list))
(list account-comm
share-amount value-amount)
(list transaction-comm
value-amount share-amount)))
;; second commodity already existing in comm-list?
(pair (assoc (car foreignlist) (cadr comm-list))))
;; if not, create a new entry in comm-list.
(if (not pair)
(begin
(set!
pair (list (car foreignlist)
(cons (gnc:make-numeric-collector)
(gnc:make-numeric-collector))))
(set!
comm-list (list (car comm-list)
(cons pair (cadr comm-list))))
(set!
sumlist (cons comm-list
(alist-delete
(car comm-list) sumlist)))))
;; And add the balances to the comm-list entry.
((caadr pair) 'add (cadr foreignlist))
((cdadr pair) 'add (caddr foreignlist))))))
;;yes, check for second commodity
(let* ((foreignlist (if cost
(create-foreign-cost-list
comm-list transaction-comm account-comm
share-amount value-amount)
(create-foreign-list
comm-list transaction-comm account-comm
share-amount value-amount)))
(pair (create-commodity-pair foreignlist comm-list
sumlist)))
(set! comm-list (list (car comm-list)
(cons pair (cadr comm-list))))
(set! sumlist (cons comm-list
(alist-delete (car comm-list) sumlist)))
((caadr pair) 'add (cadr foreignlist))
((cdadr pair) 'add (caddr foreignlist))))))

(gnc:get-all-commodity-splits curr-accounts end-date)))

(gnc:resolve-unknown-comm sumlist report-commodity)))

;; Calculate the volume-weighted average cost of all commodities,
;; priced in the 'report-commodity'. Uses all transactions up until
;; the 'end-date'. Returns an alist, see sumlist.
(define (gnc:get-exchange-cost-totals report-commodity end-date)
(let ((curr-accounts
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
;; sumlist: a multilevel alist. Each element has a commodity
;; as key, and another alist as a value. The value-alist's
;; elements consist of a commodity as a key, and a pair of two
;; value-collectors as value, e.g. with only one (the report-)
;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
;; <gnc:commodity> and the numbers are a numeric-collector
;; which in turn store a <gnc:numeric>. In the example, USD
;; 400 were bought for an amount of DEM 1000, FRF 300 were
;; bought for DEM 100. The reason for the outer alist is that
;; there might be commodity transactions which do not involve
;; the report-commodity, but which can still be calculated
;; after *all* transactions are processed.
(sumlist (list (list report-commodity '()))))

(if (not (null? curr-accounts))
;; Go through all splits and add up all value-amounts
;; and share-amounts
(for-each
(lambda (a)
(let* ((transaction-comm (xaccTransGetCurrency
(xaccSplitGetParent a)))
(account-comm (xaccAccountGetCommodity
(xaccSplitGetAccount a)))
(share-amount (xaccSplitGetAmount a))
(value-amount (xaccSplitGetValue a))
(tmp (assoc transaction-comm sumlist))
(comm-list (if (not tmp)
(assoc account-comm sumlist)
tmp)))
;; entry exists already in comm-list?
(if (not comm-list)
;; no, create sub-alist from scratch
(let ((pair (list transaction-comm
(cons (gnc:make-numeric-collector)
(gnc:make-numeric-collector)))))
((caadr pair) 'add value-amount)
((cdadr pair) 'add share-amount)
(set! comm-list (list account-comm (list pair)))
;; and add the new sub-alist to sumlist.
(set! sumlist (cons comm-list sumlist)))
;; yes, check for second commodity.
(let*
;; Put the amounts in the right place.
((foreignlist
(if (gnc-commodity-equiv transaction-comm
(car comm-list))
(list account-comm
share-amount value-amount)
(list transaction-comm
(gnc-numeric-neg value-amount)
(gnc-numeric-neg share-amount))))
;; second commodity already existing in comm-list?
(pair (assoc (car foreignlist) (cadr comm-list))))
;; if not, create a new entry in comm-list.
(if (not pair)
(begin
(set!
pair (list (car foreignlist)
(cons (gnc:make-numeric-collector)
(gnc:make-numeric-collector))))
(set!
comm-list (list (car comm-list)
(cons pair (cadr comm-list))))
(set!
sumlist (cons comm-list
(alist-delete
(car comm-list) sumlist)))))
;; And add the balances to the comm-list entry.
((caadr pair) 'add (cadr foreignlist))
((cdadr pair) 'add (caddr foreignlist))))))
(gnc:get-all-commodity-splits curr-accounts end-date)))

(gnc:resolve-unknown-comm sumlist report-commodity)))

;; Anybody feel free to reimplement any of these functions, either in
;; scheme or in C. -- cstim

(define (gnc:make-exchange-alist report-commodity end-date)
;; This returns the alist with the actual exchange rates, i.e. the
;; total balances from get-exchange-totals are divided by each
;; other.
(map
(lambda (e)
(list (car e)
(gnc-numeric-abs
(gnc-numeric-div ((cdadr e) 'total #f)
((caadr e) 'total #f)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
(gnc:get-exchange-totals report-commodity end-date)))

(define (gnc:make-exchange-cost-alist report-commodity end-date)
(define (gnc:make-exchange-alist report-commodity end-date cost)
;; This returns the alist with the actual exchange rates, i.e. the
;; total balances from get-exchange-totals are divided by each
;; other.
Expand All @@ -735,11 +652,7 @@
((caadr e) 'total #f)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
(gnc:get-exchange-cost-totals report-commodity end-date)))




(gnc:get-exchange-totals report-commodity end-date cost)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Actual functions for exchanging amounts.
Expand Down Expand Up @@ -934,11 +847,11 @@
source-option report-currency to-date-tp)
(case source-option
((average-cost) (gnc:make-exchange-function
(gnc:make-exchange-cost-alist
report-currency to-date-tp)))
(gnc:make-exchange-alist
report-currency to-date-tp #t)))
((weighted-average) (gnc:make-exchange-function
(gnc:make-exchange-alist
report-currency to-date-tp)))
report-currency to-date-tp #f)))
((pricedb-latest) gnc:exchange-by-pricedb-latest)
((pricedb-nearest) (lambda (foreign domestic)
(gnc:exchange-by-pricedb-nearest
Expand Down Expand Up @@ -970,8 +883,8 @@
(case source-option
;; Make this the same as gnc:case-exchange-fn
((average-cost) (let* ((exchange-fn (gnc:make-exchange-function
(gnc:make-exchange-cost-alist
report-currency to-date-tp))))
(gnc:make-exchange-alist
report-currency to-date-tp #t))))
(lambda (foreign domestic date)
(exchange-fn foreign domestic))))
((weighted-average) (let ((pricealist
Expand Down

0 comments on commit d9dbc3d

Please sign in to comment.