mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[category-barchart] Added option to show ratios
This commit is contained in:
Simeon
Christopher Lam
parent
f991680644
commit
fd70c88423
@ -34,6 +34,10 @@
|
||||
(use-modules (gnucash app-utils))
|
||||
(use-modules (gnucash report))
|
||||
|
||||
;; useful functions
|
||||
(define (safe-/ x y)
|
||||
(if (zero? y) 0 (/ x y)))
|
||||
|
||||
;; The option names are defined here to 1. save typing and 2. avoid
|
||||
;; spelling errors. The *reportnames* are defined here (and not only
|
||||
;; once at the very end) because I need them to define the "other"
|
||||
@ -176,6 +180,15 @@ developing over time"))
|
||||
"e" (N_ "Display a table of the selected data.")
|
||||
#f))
|
||||
|
||||
;; contributed by https://github.com/exxus
|
||||
;; https://github.com/Gnucash/gnucash/pull/1272
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display
|
||||
(N_ "Replace amounts with percentage ratios.")
|
||||
"e1" (N_ "Display percentage contribution of each account to the Gand Total instead of amounts.")
|
||||
#f))
|
||||
|
||||
(gnc:options-add-plot-size!
|
||||
options gnc:pagename-display
|
||||
optname-plot-width optname-plot-height "f" (cons 'percent 100.0) (cons 'percent 100.0))
|
||||
@ -246,6 +259,7 @@ developing over time"))
|
||||
(work-to-do 0)
|
||||
(all-data #f)
|
||||
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
|
||||
(ratio-chart? (get-option gnc:pagename-display (N_ "Replace amounts with percentage ratios.")))
|
||||
(document (gnc:make-html-document))
|
||||
(chart (gnc:make-html-chart))
|
||||
(topl-accounts (gnc:filter-accountlist-type
|
||||
@ -349,6 +363,14 @@ developing over time"))
|
||||
((pair? data) (every all-zeros data))
|
||||
(else (error 'huh))))
|
||||
|
||||
(define (get-negative-accounts data)
|
||||
(let lp ((data data) (retval #f))
|
||||
(match data
|
||||
(() retval)
|
||||
(((acc (? (cut any negative? <>))) . rest)
|
||||
(lp rest (cons (acct->name acc) (or retval '()))))
|
||||
((_ . rest) (lp rest retval)))))
|
||||
|
||||
;; this is an alist of account-balances
|
||||
;; (list (list acc0 bal0 bal1 bal2 ...)
|
||||
;; (list acc1 bal0 bal1 bal2 ...)
|
||||
@ -486,12 +508,28 @@ developing over time"))
|
||||
(gnc:html-make-empty-data-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
|
||||
((and ratio-chart? (get-negative-accounts all-data)) =>
|
||||
(lambda (neg-accounts)
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-generic-warning
|
||||
report-title (gnc:report-id report-obj)
|
||||
"Negative amounts detected"
|
||||
"Charting ratios cannot occur on accounts with negative balances. \
|
||||
Please deselect the accounts with negative balances."))
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
document (gnc:make-html-text (gnc:html-markup-ul neg-accounts)))))
|
||||
|
||||
(else
|
||||
(let* ((dates-list (if do-intervals?
|
||||
(list-head dates-list (1- (length dates-list)))
|
||||
dates-list))
|
||||
(date-string-list (map qof-print-date dates-list))
|
||||
(list-of-rows (apply zip (map cadr all-data))))
|
||||
(list-of-rows (apply zip (map cadr all-data)))
|
||||
|
||||
;; total amounts
|
||||
(row-totals (map (cut fold + 0 <>) list-of-rows)))
|
||||
|
||||
;; Set chart title, subtitle etc.
|
||||
(gnc:html-chart-set-type!
|
||||
@ -511,7 +549,8 @@ developing over time"))
|
||||
|
||||
(gnc:html-chart-set-data-labels! chart date-string-list)
|
||||
(gnc:html-chart-set-y-axis-label!
|
||||
chart (gnc-commodity-get-mnemonic report-currency))
|
||||
chart (if ratio-chart? "Ratio"
|
||||
(gnc-commodity-get-mnemonic report-currency)))
|
||||
|
||||
;; If we have too many categories, we sum them into a new
|
||||
;; 'other' category and add a link to a new report with just
|
||||
@ -572,8 +611,8 @@ developing over time"))
|
||||
gnc:optname-reportname
|
||||
(acct->name acct))))))))
|
||||
(gnc:html-chart-add-data-series!
|
||||
chart label amounts color
|
||||
'stack stack 'fill fill 'urls urls)))
|
||||
chart label (if ratio-chart? (map safe-/ amounts row-totals) amounts)
|
||||
color 'stack stack 'fill fill 'urls urls)))
|
||||
all-data
|
||||
(gnc:assign-colors (length all-data))
|
||||
(iota (length all-data)))
|
||||
@ -583,6 +622,8 @@ developing over time"))
|
||||
chart (gnc-commodity-get-mnemonic report-currency))
|
||||
(gnc:html-chart-set-currency-symbol!
|
||||
chart (gnc-commodity-get-nice-symbol report-currency))
|
||||
(gnc:html-chart-set-format-style!
|
||||
chart (if ratio-chart? "percent" "currency"))
|
||||
|
||||
(gnc:report-percent-done 98)
|
||||
(gnc:html-document-add-object! document chart)
|
||||
@ -595,20 +636,27 @@ developing over time"))
|
||||
(define (make-cell contents)
|
||||
(gnc:make-html-table-cell/markup "number-cell" contents))
|
||||
|
||||
(define (make-cell-percent amt grandt)
|
||||
(gnc:make-html-table-cell/markup "number-cell" (* (safe-/ amt grandt) 100) " %"))
|
||||
|
||||
(define (make-monetary-cell amount)
|
||||
(make-cell (gnc:make-gnc-monetary report-currency amount)))
|
||||
|
||||
(for-each
|
||||
(lambda (date row)
|
||||
(lambda (date row row-total)
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(append (list (make-cell date))
|
||||
(map make-monetary-cell row)
|
||||
(map (if ratio-chart?
|
||||
(cut make-cell-percent <> row-total)
|
||||
make-monetary-cell)
|
||||
row)
|
||||
(if cols>1?
|
||||
(list (make-monetary-cell (apply + row)))
|
||||
'()))))
|
||||
date-string-list
|
||||
list-of-rows)
|
||||
list-of-rows
|
||||
row-totals)
|
||||
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
|
||||
Loading…
Reference in New Issue
Block a user