gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Fri Mar 22 17:30:55 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/790ee4a5 (commit)
via https://github.com/Gnucash/gnucash/commit/96b65a50 (commit)
via https://github.com/Gnucash/gnucash/commit/362fb99c (commit)
via https://github.com/Gnucash/gnucash/commit/57b3531c (commit)
via https://github.com/Gnucash/gnucash/commit/9b0b233b (commit)
from https://github.com/Gnucash/gnucash/commit/4e3bd4f7 (commit)
commit 790ee4a5022f743b0d43491f5401140ca9654612
Merge: 4e3bd4f7b 96b65a50c
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Mar 22 14:09:51 2019 -0700
Merge Chris Lam's 'maint-scheme-cleanups' into maint.
commit 96b65a50c95152dd43d20da350499b4e690621ac
Author: christopherlam <christopher.lck at gmail.com>
Date: Fri Mar 22 18:45:21 2019 +0800
[report-system] deprecate stats/dr-cr collectors
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 85c149123..9ce7da797 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -686,10 +686,10 @@
(export gnc:accounts-get-commodities)
(export gnc:get-current-account-tree-depth)
(export gnc:acccounts-get-all-subaccounts)
-(export gnc:make-stats-collector)
-(export gnc:make-drcr-collector)
+(export gnc:make-stats-collector) ;deprecated
+(export gnc:make-drcr-collector) ;deprecated
(export gnc:make-value-collector)
-(export gnc:make-number-collector)
+(export gnc:make-number-collector) ;deprecated
(export gnc:make-commodity-collector)
(export gnc:commodity-collector-get-negated)
(export gnc:commodity-collectorlist-get-merged) ;deprecated
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 3bacd3a28..5f7241547 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -177,6 +177,8 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; yes. I think that would still be faster.
(define (gnc:make-stats-collector)
+ (issue-deprecation-warning
+ "gnc:make-stats-collector is obsolete. use srfi-1 functions instead.")
(let ((value 0)
(totalitems 0)
(maximum -inf.0)
@@ -209,6 +211,8 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(else (gnc:warn "bad stats-collector action: " action)))))))
(define (gnc:make-drcr-collector)
+ (issue-deprecation-warning
+ "gnc:make-drcr-collector is obsolete. use srfi-1 functions instead.")
(let ;;; values
((debits 0)
(credits 0)
commit 362fb99c13d0e9a4dffd3b39e05e5159010a273c
Author: christopherlam <christopher.lck at gmail.com>
Date: Fri Mar 22 21:06:23 2019 +0800
[average-balance] handle include-subaccts? earlier
much simpler
diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm
index 6fcf19395..ba1803a2d 100644
--- a/gnucash/report/standard-reports/average-balance.scm
+++ b/gnucash/report/standard-reports/average-balance.scm
@@ -177,7 +177,11 @@
(internal-included (not (get-option gnc:pagename-accounts optname-internal)))
(accounts (get-option gnc:pagename-accounts (N_ "Accounts")))
(dosubs? (get-option gnc:pagename-accounts optname-subacct))
-
+ (accounts (append accounts
+ (if dosubs?
+ (filter (lambda (acc) (not (member acc accounts)))
+ (gnc:acccounts-get-all-subaccounts accounts))
+ '())))
(plot-type (get-option gnc:pagename-display (N_ "Plot Type")))
(show-plot? (get-option gnc:pagename-display (N_ "Show plot")))
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
@@ -202,11 +206,9 @@
;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly.
(gnc:report-percent-done 1)
- (set! commodity-list (gnc:accounts-get-commodities
- (append
- (gnc:acccounts-get-all-subaccounts accounts)
- accounts)
- report-currency))
+ (set! commodity-list (gnc:accounts-get-commodities
+ accounts report-currency))
+
(gnc:report-percent-done 5)
(set! exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
@@ -224,22 +226,6 @@
;; add accounts to the query (include subaccounts
;; if requested)
(gnc:report-percent-done 25)
- (if dosubs?
- (let ((subaccts '()))
- (for-each
- (lambda (acct)
- (let ((this-acct-subs
- (gnc-account-get-descendants-sorted acct)))
- (if (list? this-acct-subs)
- (set! subaccts
- (append subaccts this-acct-subs)))))
- accounts)
- ;; Beware: delete-duplicates is an O(n^2)
- ;; algorithm. More efficient method: sort the list,
- ;; then use a linear algorithm.
- (set! accounts
- (delete-duplicates (append accounts subaccts)))))
- (gnc:report-percent-done 30)
(xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
commit 57b3531ce6ac032472d4c4f0228df8d3e1e6968a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 16 17:24:07 2019 +0800
Bug 748431 - Wrong average balance for transactions during DST
Replace average-splits with custom loop, cycling through the
balancelist and splitlist, creating interval summaries along the way.
diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm
index 90c708347..6fcf19395 100644
--- a/gnucash/report/standard-reports/average-balance.scm
+++ b/gnucash/report/standard-reports/average-balance.scm
@@ -148,164 +148,6 @@
(_ "Maximum") (_ "Minimum") (_ "Gain")
(_ "Loss") (_ "Profit") ))
-;; analyze-splits crunches a split list into a set of period
-;; summaries. Each summary is a list of (start-date end-date
-;; avg-bal max-bal min-bal total-in total-out net) if multiple
-;; accounts are selected the balance is the sum for all. Each
-;; balance in a foreign currency will be converted to a double in
-;; the report-currency by means of the monetary->double
-;; function.
-(define (analyze-splits splits start-bal-double
- start-date end-date interval monetary->double
- internal)
- (let ((interval-list
- (gnc:make-date-interval-list start-date end-date interval))
- (data-rows '()))
-
- (define (output-row interval-start
- interval-end
- stats-accum
- minmax-accum
- gain-loss-accum)
- (set! data-rows
- (cons
- (list (qof-print-date interval-start)
- (qof-print-date interval-end)
- (/ (stats-accum 'total #f)
- (- interval-end
- interval-start))
- (minmax-accum 'getmax #f)
- (minmax-accum 'getmin #f)
- (gain-loss-accum 'debits #f)
- (gain-loss-accum 'credits #f)
- (- (gain-loss-accum 'debits #f)
- (gain-loss-accum 'credits #f)))
- data-rows)))
-
- ;; Returns a double which is the split value, correctly
- ;; exchanged to the current report-currency. We use the exchange
- ;; rate at the 'date'.
- (define (get-split-value split date)
- (monetary->double
- (gnc:make-gnc-monetary
- (xaccAccountGetCommodity (xaccSplitGetAccount split))
- (xaccSplitGetAmount split))
- date))
-
- ;; calculate the statistics for one interval - returns a list
- ;; containing the following:
- ;; min-max acculumator
- ;; average-accumulator
- ;; gain-loss accumulator
- ;; final balance for this interval
- ;; splits remaining to be processed.
-
- ;; note that it is assumed that every split in in the list
- ;; has a date >= from
-
- (define (process-interval splits from to start-balance)
-
- (let ((minmax-accum (gnc:make-stats-collector))
- (stats-accum (gnc:make-stats-collector))
- (gain-loss-accum (gnc:make-drcr-collector))
- (last-balance start-balance)
- (last-balance-time from))
-
-
- (define (update-stats split-amt split-time)
- (let ((time-difference (- split-time
- last-balance-time)))
- (stats-accum 'add (* last-balance time-difference))
- (set! last-balance (+ last-balance split-amt))
- (set! last-balance-time split-time)
- (minmax-accum 'add last-balance)
- (gain-loss-accum 'add split-amt)))
-
- (define (split-recurse)
- (if (or (null? splits)
- (> (xaccTransGetDate (xaccSplitGetParent (car splits)))
- to))
- #f
- (let*
- ((split (car splits))
- (split-time (xaccTransGetDate (xaccSplitGetParent split)))
- ;; FIXME: Which date should we use here? The 'to'
- ;; date? the 'split-time'?
- (split-amt (get-split-value split split-time))
- (next (cdr splits)))
-
- (if
- ;; Check whether this split and next one are a pair
- ;; from the same transaction, and the only ones in
- ;; this transaction.
- ;; If they are and the flag is set appropriately,
- ;; then skip both.
- (or internal
- (null? next)
- (let* ((next-split (car next))
- (trans (xaccSplitGetParent split))
- (next-trans (xaccSplitGetParent next-split))
- (count (xaccTransCountSplits trans)))
- (not (and (eqv? count 2)
- (equal? trans next-trans)))))
- (begin
- (gnc:debug "split " split)
- (gnc:debug "split-time " split-time)
- (gnc:debug "split-amt " split-amt)
- ;; gnc:debug converts its input to a string before
- ;; deciding whether to print it, and converting
- ;; |splits| to a string is O(N) in its length. Since
- ;; this code runs for every split, leaving that
- ;; gnc:debug in makes the whole thing O(N^2) in number
- ;; of splits. If someone really needs this output,
- ;; they should uncomment the gnc:debug call.
- ; (gnc:debug "splits " splits)
- (update-stats split-amt split-time)
- (set! splits next)
- (split-recurse))
- (begin
- (set! splits (cdr next))
- (split-recurse))))))
-
- ; the minmax accumulator
-
- (minmax-accum 'add start-balance)
-
- (if (not (null? splits))
- (split-recurse))
-
- ;; insert a null transaction at the end of the interval
- (update-stats 0.0 to)
- (list minmax-accum stats-accum gain-loss-accum last-balance splits)))
-
-
- (for-each
- (lambda (interval)
- (let*
-
- ((interval-results
- (process-interval
- splits
- (car interval)
- (cadr interval)
- start-bal-double))
- (min-max-accum (car interval-results))
- (stats-accum (cadr interval-results))
- (gain-loss-accum (caddr interval-results))
- (last-bal (cadddr interval-results))
- (rest-splits (list-ref interval-results 4)))
-
- (set! start-bal-double last-bal)
- (set! splits rest-splits)
- (output-row (car interval)
- (cadr interval)
- stats-accum
- min-max-accum gain-loss-accum)))
- interval-list)
-
-
- (reverse data-rows)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Renderer
@@ -344,29 +186,12 @@
(commodity-list #f)
(exchange-fn #f)
-
- (beforebegindate (gnc:time64-end-day-time
- (gnc:time64-previous-day begindate)))
- (all-zeros? #t)
- ;; startbal will be a commodity-collector
- (startbal '()))
-
- (define (list-all-zeros? alist)
- (if (null? alist) #t
- (if (not (= 0.0 (car alist)))
- #f
- (list-all-zeros? (cdr alist)))))
-
- (define (monetary->double foreign-monetary date)
- (gnc-numeric-to-double
- (gnc:gnc-monetary-amount
- (exchange-fn foreign-monetary report-currency date))))
+ (all-zeros? #t))
;;(warn commodity-list)
(if (not (null? accounts))
(let ((query (qof-query-create-for-splits))
- (splits '())
(data '()))
;; The percentage done numbers here are a hack so that
@@ -426,35 +251,137 @@
(list QUERY-DEFAULT-SORT)
'())
- ;; get the query results
- (set! splits (qof-query-run query))
(gnc:report-percent-done 40)
-
- ;; find the net starting balance for the set of accounts
- (set! startbal
- (gnc:accounts-get-balance-helper
- accounts
- (lambda (acct) (gnc:account-get-comm-balance-at-date
- acct beforebegindate #f))
- (lambda (x) #f)))
- (gnc:report-percent-done 50)
-
- (set! startbal
- (gnc-numeric-to-double
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- startbal
- report-currency
- (lambda (a b)
- (exchange-fn a b beforebegindate))))))
- (gnc:report-percent-done 60)
-
- ;; and analyze the data
- (set! data (analyze-splits splits startbal
- begindate enddate
- stepsize monetary->double
- internal-included))
- (gnc:report-percent-done 70)
+
+ (let* ((splits (qof-query-run query))
+ (daily-dates (gnc:make-date-list begindate enddate DayDelta))
+ (interval-dates (gnc:make-date-list begindate enddate stepsize))
+ (accounts-balances (map
+ (lambda (acc)
+ (gnc:account-get-balances-at-dates
+ acc daily-dates))
+ accounts))
+ (accounts-balances-transposed (if (null? accounts-balances)
+ '()
+ (apply zip accounts-balances)))
+ (balances (map
+ (lambda (date accounts-balance)
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ (apply gnc:monetaries-add accounts-balance)
+ report-currency
+ (lambda (monetary target-curr)
+ (exchange-fn monetary target-curr date)))))
+ daily-dates
+ accounts-balances-transposed)))
+
+ ;; this is a complicated tight loop. start with:
+ ;; daily-balances & daily-dates, interval-dates, and the
+ ;; splitlist. traverse the daily balances and splitlist
+ ;; until we cross an interval date boundary, then
+ ;; summarize the interval-balances and interval-amounts
+ (let loop ((results '())
+ (interval-bals '())
+ (interval-amts '())
+ (splits splits)
+ (daily-balances (cdr balances))
+ (daily-dates (cdr daily-dates))
+ (interval-start (car interval-dates))
+ (interval-dates (cdr interval-dates)))
+ (cond
+
+ ;; daily-dates finished. job done. add details for
+ ;; last-interval which must be handled separately.
+ ((null? daily-dates)
+ (set! data
+ (reverse!
+ (cons (list
+ (qof-print-date interval-start)
+ (qof-print-date (car interval-dates))
+ (/ (apply + interval-bals)
+ (length interval-bals))
+ (apply max interval-bals)
+ (apply min interval-bals)
+ (apply + (filter positive? interval-amts))
+ (- (apply + (filter negative? interval-amts)))
+ (apply + interval-amts))
+ results))))
+
+ ;; first daily-date > first interval-date -- crossed
+ ;; interval boundary -- add interval details to results
+ ((> (car daily-dates) (car interval-dates))
+ (loop (cons (list
+ (qof-print-date interval-start)
+ (qof-print-date (decdate (car interval-dates)
+ DayDelta))
+ (/ (apply + interval-bals)
+ (length interval-bals))
+ (apply max interval-bals)
+ (apply min interval-bals)
+ (apply + (filter positive? interval-amts))
+ (- (apply + (filter negative? interval-amts)))
+ (apply + interval-amts))
+ results)
+ '()
+ '()
+ splits
+ daily-balances
+ daily-dates
+ (car interval-dates)
+ (cdr interval-dates)))
+
+ ;; we're still within interval. there are splits
+ ;; remaining. test whether 'internal' and optionally
+ ;; skip 2 splits; otherwise add split details
+ ((and (pair? splits)
+ (< (xaccTransGetDate (xaccSplitGetParent (car splits)))
+ (car interval-dates)))
+ (let* ((this (car splits))
+ (rest (cdr splits))
+ (next (and (pair? rest) (car rest)))
+ (this-txn (xaccSplitGetParent this))
+ (next-txn (and next (xaccSplitGetParent next))))
+ (if (and (not internal-included)
+ (= 2 (xaccTransCountSplits this-txn))
+ (equal? this-txn next-txn))
+ (loop results
+ interval-bals
+ interval-amts ;interval-amt unchanged
+ (cddr splits) ;skip two splits
+ daily-balances
+ daily-dates
+ interval-start
+ interval-dates)
+ (loop results
+ interval-bals
+ (cons (gnc:gnc-monetary-amount
+ (exchange-fn
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity
+ (xaccSplitGetAccount (car splits)))
+ (xaccSplitGetAmount (car splits)))
+ report-currency
+ (car interval-dates)))
+ interval-amts) ;add split amt to list
+ rest ;and move to next
+ daily-balances
+ daily-dates
+ interval-start
+ interval-dates))))
+
+ ;; we're still within interval, no more splits
+ ;; left. add daily balance to interval.
+ (else
+ (loop results
+ (cons (car daily-balances) interval-bals)
+ interval-amts
+ splits
+ (cdr daily-balances)
+ (cdr daily-dates)
+ interval-start
+ interval-dates)))))
+
+ (gnc:report-percent-done 70)
;; make a plot (optionally)... if both plot and table,
;; plot comes first.
@@ -469,7 +396,7 @@
((number-data
(map
(lambda (row) (list-ref row 2)) data)))
- (if (not (list-all-zeros? number-data))
+ (if (not (every zero? number-data))
(begin
(gnc:html-barchart-append-column!
barchart
@@ -485,7 +412,7 @@
(if (memq 'GainPlot plot-type)
(let ((number-data
(map (lambda (row) (list-ref row 7)) data)))
- (if (not (list-all-zeros? number-data))
+ (if (not (every zero? number-data))
(begin
(gnc:html-barchart-append-column!
barchart
@@ -504,8 +431,8 @@
(map (lambda (row) (list-ref row 6)) data)))
;; debit column
(if (not (and
- (list-all-zeros? debit-data)
- (list-all-zeros? credit-data)))
+ (every zero? debit-data)
+ (every zero? credit-data)))
(begin
(gnc:html-barchart-append-column!
barchart
commit 9b0b233bf46de1c69442c5301dd132168dfd5170
Author: christopherlam <christopher.lck at gmail.com>
Date: Thu Mar 21 20:58:26 2019 +0800
[test-average-balance] create tests
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index da7fe6400..7cd7159e7 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -13,6 +13,7 @@ set(scm_test_with_srfi64_SOURCES
test-income-gst.scm
test-budget.scm
test-register.scm
+ test-average-balance.scm
)
set(scm_test_with_textual_ports_SOURCES
diff --git a/gnucash/report/standard-reports/test/test-average-balance.scm b/gnucash/report/standard-reports/test/test-average-balance.scm
new file mode 100644
index 000000000..2221f8d5c
--- /dev/null
+++ b/gnucash/report/standard-reports/test/test-average-balance.scm
@@ -0,0 +1,84 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report standard-reports average-balance))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report standard-reports budget))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+
+;; Explicitly set locale to make the report output predictable
+(setlocale LC_ALL "C")
+
+(define uuid "d5adcc61c62e4b8684dd8907448d7900") ;average-balance
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-average-balance")
+ (test-average-balance)
+ (test-end "test-average-balance"))
+
+(define (set-option! options page tag value)
+ ((gnc:option-setter (gnc:lookup-option options page tag)) value))
+
+(define (teardown)
+ (gnc-clear-current-session))
+
+(define (options->sxml options test-title)
+ (gnc:options->sxml uuid options "test-average-balance"
+ test-title #:strip-tag "script"))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Bank")
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))))
+
+(define (get-row-col sxml row col)
+ (sxml->table-row-col sxml 1 row col))
+
+(define (test-average-balance)
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (options (gnc:make-report-options uuid))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (income (cdr (assoc "Income" account-alist))))
+
+ (define (default-testing-options)
+ ;; To ease testing of transaction report, we will set default
+ ;; options for generating reports. We will elable extra columns
+ ;; for Exporting, disable generation of informational text, and
+ ;; disable indenting. These options will be tested separately as
+ ;; the first test group. By default, we'll select the modern dates.
+ (let ((options (gnc:make-report-options uuid)))
+ (set-option! options "Accounts" "Accounts" (list bank))
+ (set-option! options "Display" "Show table" #t)
+ (set-option! options "General" "Start Date"
+ (cons 'absolute (gnc-dmy2time64 01 01 1979)))
+ (set-option! options "General" "End Date"
+ (cons 'absolute (gnc-dmy2time64 30 06 1979)))
+ options))
+
+ (env-transfer env 15 02 1979 income bank 100)
+ (env-transfer env 16 04 1979 income bank 100)
+
+ (let* ((options (default-testing-options))
+ (sxml (options->sxml options "default")))
+ (test-equal "averages"
+ '("0.00" "50.00" "100.00" "150.00" "200.00" "200.00")
+ (get-row-col sxml #f 3))
+ (test-equal "maximums"
+ '("0.00" "100.00" "100.00" "200.00" "200.00" "200.00")
+ (get-row-col sxml #f 4))
+ (test-equal "minimums"
+ '("0.00" "0.00" "100.00" "100.00" "200.00" "200.00")
+ (get-row-col sxml #f 5))
+ (test-equal "net"
+ '("0.00" "100.00" "0.00" "100.00" "0.00" "0.00")
+ (get-row-col sxml #f 8)))
+ (teardown)))
Summary of changes:
gnucash/report/report-system/report-system.scm | 6 +-
gnucash/report/report-system/report-utilities.scm | 4 +
.../report/standard-reports/average-balance.scm | 373 ++++++++-------------
.../report/standard-reports/test/CMakeLists.txt | 1 +
.../standard-reports/test/test-average-balance.scm | 84 +++++
5 files changed, 235 insertions(+), 233 deletions(-)
create mode 100644 gnucash/report/standard-reports/test/test-average-balance.scm
More information about the gnucash-changes
mailing list