;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; investment-commodities-over-time.scm ;; by Johan Vanbockryck in April/May 2022 ;; ;; Heavily based on ;; portfolio.scm by Robert Merkel (rgmerk@mira.net) ;; advanced-portfolio.scm by Martijn van Oosterhout (kleptog@svana.org) ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2 of ;; the License, or (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; ;; Free Software Foundation Voice: +1-617-542-5942 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ;; Boston, MA 02110-1301, USA gnu@gnu.org ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-module (gnucash reports commodities-over-time)) (use-modules (gnucash engine)) (use-modules (gnucash utilities)) (use-modules (gnucash core-utils)) (use-modules (gnucash app-utils)) (use-modules (gnucash report)) (use-modules (srfi srfi-1)) (define reportname (N_ "Investment Commodities Over Time")) (define optname-show-symbol (N_ "Show ticker symbols")) (define optname-show-listing (N_ "Show listings")) (define optname-show-total (N_ "Show total difference")) (define optname-zero-shares (N_ "Include accounts with no shares")) (define optname-diff-calculation (N_ "Difference calculation")) (define optname-from-date (N_ "Start Date")) (define optname-to-date (N_ "End Date")) (define optname-stepsize (N_ "Step Size")) (define optname-show-chart (N_ "Show Chart")) (define optname-plot-width (N_ "Plot Width")) (define optname-plot-height (N_ "Plot Height")) (define optname-line-width (N_ "Line Width")) (define opthelp-line-width (N_ "Set line width in pixels.")) (define optname-markers (N_ "Data markers?")) (define optname-y-grid (N_ "Grid")) (define (options-generator) (let* ((options (gnc:new-options)) ;; This is just a helper function for making options. ;; See libgnucash/scm/options.scm for details. (add-option (lambda (new-option) (gnc:register-option options new-option)))) ;; General Tab ;; date at which to report balance (gnc:options-add-date-interval! options gnc:pagename-general optname-from-date optname-to-date "a") (gnc:options-add-interval-choice! options gnc:pagename-general optname-stepsize "b" 'MonthDelta) (gnc:options-add-currency! options gnc:pagename-general (N_ "Report's currency") "c") (gnc:register-option options (gnc:make-multichoice-option gnc:pagename-general optname-diff-calculation "d" (G_ "How the increase/decrease will be calculated for each interval: compare the delta of the interval to the start of the interval (Delta over pervious), compare the delta of the interval to the value at the start of the report (Delta over beginning) or compare the delta since the start of the report with the value at the start of the report (Overall over beginning).") 'deltaprevious (list (vector 'deltaprevious (G_ "Delta over previous")) (vector 'deltabeginning (G_ "Delta over beginning")) (vector 'overallbeginning (G_ "Overall over beginning"))))) ;; Display Tab (gnc:register-option options (gnc:make-simple-boolean-option gnc:pagename-display optname-show-symbol "a" (N_ "Display the ticker symbols.") #t)) (gnc:register-option options (gnc:make-simple-boolean-option gnc:pagename-display optname-show-listing "b" (N_ "Display exchange listings.") #t)) (gnc:register-option options (gnc:make-simple-boolean-option gnc:pagename-display optname-show-total "c" (N_ "Show the total difference percentage.") #t)) (gnc:register-option options (gnc:make-simple-boolean-option gnc:pagename-display optname-show-chart "d" (N_ "Show a chart of the percentages.") #t)) (gnc:options-add-plot-size! options gnc:pagename-display optname-plot-width optname-plot-height "e" (cons 'percent 100.0) (cons 'percent 100.0)) (add-option (gnc:make-number-range-option gnc:pagename-display optname-line-width "f" opthelp-line-width 1.5 0.5 5 1 0.1 )) (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-y-grid "g" (N_ "Add grid lines.") #t)) (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-markers "h" (N_ "Display a mark for each data point.") #t)) ;; Account tab (add-option (gnc:make-account-list-option gnc:pagename-accounts (N_ "Accounts") "b" (N_ "Stock Accounts to report on.") (lambda () (filter gnc:account-is-stock? (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) (lambda (accounts) (list #t (filter gnc:account-is-stock? accounts))) #t)) (gnc:register-option options (gnc:make-simple-boolean-option gnc:pagename-accounts optname-zero-shares "e" (N_ "Include accounts that have a zero share balances at the end of the reporting window.") #f)) (gnc:options-set-default-section options gnc:pagename-general) options)) ;; Taken from fin.scm (define (roundToPlaces value places) (if (= places 999) value (/ (round (* value (expt 10 places))) (expt 10 places)) ) ) ;; This is the rendering function. It accepts a database of options ;; and generates an object of type . See the file ;; report-html.txt for documentation; the file report-html.scm ;; includes all the relevant Scheme code. The option database passed ;; to the function is one created by the options-generator function ;; defined above. (define (commodities-renderer report-obj) ;; These are some helper functions for looking up option values. (define (get-op section name) (gnc:lookup-option (gnc:report-options report-obj) section name)) (define (get-option section name) (gnc:option-value (get-op section name))) (let ((work-done 0) (work-to-do 0) (chart-width (get-option gnc:pagename-display optname-plot-width)) (chart-height (get-option gnc:pagename-display optname-plot-height)) (chart-line-width (get-option gnc:pagename-display optname-line-width)) (chart-grid (get-option gnc:pagename-display optname-y-grid)) (chart-markers (if (get-option gnc:pagename-display optname-markers) 3 0)) ) ;; Utility method to check if the two supplied accounts are the same account (define (same-account? a1 a2) (equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2))) ;; Method for adding the headers for the different interval dates (define (table-add-date-headers header-list dates-list) (if (null? dates-list) header-list (let* ( (current-date (car dates-list)) (remaining-dates (cdr dates-list)) (new-header (qof-print-date current-date)) ) (append! header-list (list new-header)) (table-add-date-headers header-list remaining-dates) ) ) ) ;; Method for getting the number of units and the value per units of a account on a specific date (define (get-account-state-at-date account commodity the-date price-fn) (let* ( (unit-collector (gnc:account-get-comm-balance-at-date account the-date #f)) (units (cadr (unit-collector 'getpair commodity #f))) (price-info (price-fn commodity the-date)) (price (car price-info)) (price-value (if price (gnc-price-get-value price) #f)) ) (if price (gnc-price-unref price)) (cons units price-value) ) ) ;; Method for calculating how much percentage-wise the difference between start-value and end-value is, when comparing them to the total-value. If any of them is #f, then the result is #nil. If total-value is 0, then the result is #f (can't divide by 0) (define (calc-diff start-value end-value total-value) (if (and start-value end-value total-value (not (gnc-numeric-zero-p total-value))) (gnc-numeric-div (gnc-numeric-mul (gnc-numeric-sub end-value start-value GNC-DENOM-AUTO GNC-DENOM-REDUCE) 100 GNC-DENOM-AUTO GNC-DENOM-REDUCE) total-value GNC-DENOM-AUTO GNC-DENOM-REDUCE) #nil ) ) ;; Method for creating a table cell that will display the supplied price difference (define (create-price-difference-table-cell price-diff) (let *( (price-style (if price-diff (if (< price-diff 0) "number-cell-neg" "number-cell") "number-cell" ) ) (price-display (if price-diff (format #f "~,2@f%" price-diff) "-")) ) (gnc:make-html-table-cell/markup price-style price-display) ) ) (define (add-stock-rows table chart accounts begindate enddate stepsize currency price-fn include-empty show-symbol show-listing show-total diff-calculation) (let ( (share-print-info (gnc-share-print-info-places (inexact->exact 2) ) ) ) (define (add-stock-rows-internal accounts odd-row?) (if (null? accounts) #f (let* ( (row-style (if odd-row? "normal-row" "alternate-row")) (current (car accounts)) ;; Account (rest (cdr accounts)) (commodity (xaccAccountGetCommodity current)) (ticker-symbol (gnc-commodity-get-mnemonic commodity)) ;; Symbol (listing (gnc-commodity-get-namespace commodity)) ;; Listing (units (car (get-account-state-at-date current commodity enddate price-fn))) (result-row (list (gnc:make-html-table-cell/markup "anchor-cell" (gnc:html-account-anchor current)))) (interval-dates (gnc:make-date-list begindate enddate stepsize)) (split-factors '()) ;; The points where the active account had a split/merger. Contains the transaction date and the split factor to multiply with (account-values '()) ;; The calculated values to use as row values or chart values for this account. ) ;; Method for iterating over the interval dates and collecting the information of the account, which will be processed later. (define (account-collect-data account-data price-fn commodity previous-date dates-list) (if (null? dates-list) account-data (let* ( (current-date (gnc:time64-end-day-time (car dates-list))) ;; Calculate at the end of the day, so that all changes of that day are taken into account (including splits/mergers) (remaining-dates (cdr dates-list)) (account-state (get-account-state-at-date current commodity current-date price-fn)) (units (car account-state)) (price-value (cdr account-state)) (split-factor (if previous-date (get-stock-split-factor previous-date current-date) 1)) (account-state (list (car account-state) (cdr account-state) split-factor)) ) (if (and (not (gnc-numeric-zero-p units)) (not (gnc-numeric-zero-p price-value))) ;; If there are units and a value at the start of this interval, use this info (set! account-data (append account-data (list account-state))) ;; If there are no units at the start of the interval, but there are at the end, use the value at the start of the interval, but with 0 units, since units were bought within this interval (let* ( (next-date (if (not (null? remaining-dates)) (car remaining-dates) #nil)) (next-account-state (if next-date (get-account-state-at-date current commodity next-date price-fn) #nil)) ) (if (and next-account-state (not (gnc-numeric-zero-p (car next-account-state)))) (set! account-data (append account-data (list (append (list 0) (cdr account-state))))) ;; There are no units at the start or the end of the interval, don't put anything for it (set! account-data (append account-data (list #nil))) ) ) ) (account-collect-data account-data price-fn commodity current-date remaining-dates) ) ) ) ;; Method for getting the value of the first entry of the account data which contains actual data (define (get-first-account-value account-data) (if (null? account-data) #f (let* ( (current-account-data (car account-data)) (remaining-account-data (cdr account-data)) ) (if current-account-data (car (cdr current-account-data)) (get-first-account-value remaining-account-data) ) ) ) ) ;; Method for getting the value of the last entry of the account data which contains actual data (define (get-last-account-value account-data) (if (null? account-data) #f (let* ( (current-account-data (car (reverse account-data))) (remaining-account-data (reverse (cdr (reverse account-data)))) ) (if current-account-data (car (cdr current-account-data)) (get-last-account-value remaining-account-data) ) ) ) ) ;; Method for calculating the account values that will be used in the table rows and/or chart data series (define (calculate-account-values account-data total-value delta-start) (define is-first #t) (define previous-value #nil) (for-each (lambda(account-data-entry) (let* ( (current-value (if account-data-entry (car (cdr account-data-entry)) #nil)) (split-factor (if account-data-entry (car (reverse account-data-entry)) 1)) ) ;; If a total-value is supplied, we need to update it with the split-factor to account for stock split/merges that occured in the time window of this entry (if total-value (set! total-value (gnc-numeric-mul total-value split-factor GNC-DENOM-AUTO GNC-DENOM-REDUCE)) ) ;; If we have a current and previous value, add them to the result row (it can't be the first item - which has to be skipped - since that has no previous value) (if (and current-value previous-value) (begin (let* ( (diff-start (if delta-start (gnc-numeric-mul previous-value split-factor GNC-DENOM-AUTO GNC-DENOM-REDUCE) total-value)) (price-diff (calc-diff diff-start current-value (if total-value total-value (gnc-numeric-mul previous-value split-factor GNC-DENOM-AUTO GNC-DENOM-REDUCE)))) ) (if (not is-first) (set! account-values (append account-values (list price-diff))) ) ) ) ;; If there is no current result, add an empty result (the account isn't used at this point in time). But if there is a current but no previous, add a 0 (it's the first usage of the account, so it hasn't changed yet. ;; Except if it's the frist item (that we have to skip) (if (not is-first) (if current-value (set! account-values (append account-values (list #f))) ;; No previous value, but a current value => we can't show a performance comparison in the table, but the chart should start from 0 here (set! account-values (append account-values (list #nil))) ;; No previous or current value => nothing in this account in this interval, so both table and chart should remain empty ) ) ) ;; If we only have a current value, but no previous value, it's the first occurance of this account, and we should add a 0 to indicate that it hasn't changed yet. (set! is-first #f) (set! previous-value current-value) ) ) account-data ) ) ;; Method for adding the table row entries for the account-values that have been calculated before (define (row-add-result-internal internal-result-row account-data show-total) (let* ( (account-start-value (get-first-account-value account-data)) (account-end-value (get-last-account-value account-data)) ) (for-each (lambda(account-value) (let ( (account-value-html (create-price-difference-table-cell (if account-value account-value #nil))) ) (append! internal-result-row (list account-value-html)) ) ) account-values ) (if (and show-total account-start-value account-end-value) (let* ( (split-factor (get-stock-split-factor begindate enddate)) (price-diff (calc-diff (gnc-numeric-mul account-start-value split-factor GNC-DENOM-AUTO GNC-DENOM-REDUCE) account-end-value (gnc-numeric-mul account-start-value split-factor GNC-DENOM-AUTO GNC-DENOM-REDUCE))) (total-price (create-price-difference-table-cell price-diff)) ) (append! internal-result-row (list total-price)) ) ) internal-result-row ) ) ;; Method to check the transactions in the supplied account, and populate the split-factors with the stock split/mergers that were encountered, identified by timestamp and unit value increase/decrease factor ;; I took a long hard look at the "Advanced Portfolio" report, extracted those parts that detected stock splits/mergers and distilled that into this method. If this is right, all credit to me, otherwise I blame Martijn van Oosterhout as author of the original report ;-) (define (calculcate-stock-splits account) (define seen_trans '()) (for-each (lambda(account-split) (let* ((account-split-parent (xaccSplitGetParent account-split))) ;; If multiple splits belong to the same transaction, make sure we don't process the transaction multiple times (if (not (assoc-ref seen_trans (gncTransGetGUID account-split-parent))) (let* ( (transaction-date (xaccTransGetDate account-split-parent)) ) ;; It's a new transaction, add it to the list of seen transactions so we don't process it again later on (set! seen_trans (acons (gncTransGetGUID account-split-parent) #t seen_trans)) (for-each (lambda(trans-split) (let* ( (split-units (xaccSplitGetAmount trans-split)) (split-value (xaccSplitGetValue trans-split)) (is-same-account (same-account? current (xaccSplitGetAccount trans-split))) ) ;; If the account of the transaction split is the same account as the one we're processing, and there is a unit change but no value change, then this is a stock split/merger (if (and is-same-account (gnc-numeric-zero-p split-value) (not (gnc-numeric-zero-p split-units))) (let* ( ;; The factor increase/decrease for the split/merger can be deduced by looking at the size of the unit change, compared to the end balance of the account (= end unit size) after the split (split-balance (xaccSplitGetBalance account-split)) (split-factor (gnc-numeric-div (gnc-numeric-sub split-balance split-units GNC-DENOM-AUTO GNC-DENOM-REDUCE) split-balance GNC-DENOM-AUTO GNC-DENOM-REDUCE)) ;; Set the split date at noon, so that it's always taken into account with our calculations for that day (which we always perform at "end of day") (split-date (time64CanonicalDayTime transaction-date)) ) ;; Add this split/merger factor to the list, together with the date when in occurred. (set! split-factors (append split-factors (list (cons split-date split-factor)))) (gnc:debug "trans-split=" trans-split "; split-units=" split-units "; split-value=" split-value "; is-same-account=" is-same-account "; split-balance=" split-balance "; split-factor=" split-factor "; transaction-date=" transaction-date) ) ) ) ) (xaccTransGetSplitList account-split-parent) ) ) ) ) ) (xaccAccountGetSplitList account) ) (gnc:debug "The split factors for account '" (xaccAccountGetName account) "' are " split-factors) ) ;; Method to get the stock split factor to use (due to stock splits or merges) when comparing the supplied end-date with the supplied begin-date (define (get-stock-split-factor begin-date end-date) (define factor 1) (if split-factors (for-each (lambda(split-factor) (let ( (split-factor-date (car split-factor)) (split-factor-value (cdr split-factor)) ) (if (and (<= begin-date split-factor-date) (> end-date split-factor-date)) (set! factor (gnc-numeric-mul factor split-factor-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)) ) ) ) split-factors ) ) factor ) ;; Method for converting the calculated account values into values that can be used for the linechart. (define (account-values-to-chart-values account-values) (define chart-values '()) (for-each (lambda(account-value) (if account-value (set! chart-values (append chart-values (list (roundToPlaces account-value 2)))) (set! chart-values (append chart-values (list (if (equal? account-value #f) 0 #nil)))) ) ) account-values ) chart-values ) (if (or include-empty (not (gnc-numeric-zero-p units))) (begin (calculcate-stock-splits current) (gnc:debug "The split factor for this account is " (get-stock-split-factor begindate enddate)) (let* ( (account-data (account-collect-data '() price-fn commodity #nil interval-dates)) (account-start-value (get-first-account-value account-data)) (account-end-value (get-last-account-value account-data)) (diff-total-value (if (equal? diff-calculation 'deltaprevious) #nil account-start-value)) ;; If the diff calculation is "deltaprevious", don't supply a "total" value to the calculation since it will compare with the start of the interval (diff-delta-start (if (equal? diff-calculation 'overallbeginning) #f #t)) ;; If the diff calculation is "overallbeginning", each delta should be calculated vs the start of the report instead of vs the previous interval ) (calculate-account-values account-data diff-total-value diff-delta-start) (if chart (gnc:html-chart-add-data-series! chart (xaccAccountGetName current) (account-values-to-chart-values account-values) (car (reverse (gnc:assign-colors (+ (length rest) 1)))) 'spanGaps #f 'fill #f 'pointRadius chart-markers 'borderWidth chart-line-width) ) (if show-symbol (append! result-row (list (gnc:make-html-table-cell/markup "anchor-cell" ticker-symbol)))) (if show-listing (append! result-row (list (gnc:make-html-table-cell/markup "anchor-cell" listing)))) (set! result-row (row-add-result-internal result-row account-data show-total)) (gnc:html-table-append-row/markup! table row-style result-row) ) ) ) (set! work-done (+ 1 work-done)) (gnc:report-percent-done (* 100 (/ work-done work-to-do))) (add-stock-rows-internal rest odd-row?) ) ) ) (set! work-to-do (length accounts)) (add-stock-rows-internal accounts #t) ) ) ;; Tell the user that we're starting. (gnc:report-starting reportname) ;; The first thing we do is make local variables for all the specific ;; options in the set of options given to the function. This set will ;; be generated by the options generator above. (let* ( (begindate (gnc:time64-end-day-time (gnc:date-option-absolute-time (get-option gnc:pagename-general optname-from-date)))) (enddate (gnc:time64-end-day-time (gnc:date-option-absolute-time (get-option gnc:pagename-general optname-to-date)))) (stepsize (gnc:deltasym-to-delta (get-option gnc:pagename-general optname-stepsize))) (show-symbol (get-option gnc:pagename-display optname-show-symbol)) (show-listing (get-option gnc:pagename-display optname-show-listing)) (show-total (get-option gnc:pagename-display optname-show-total)) (show-chart (get-option gnc:pagename-display optname-show-chart)) (diff-calculation (get-option gnc:pagename-general optname-diff-calculation)) (accounts (get-option gnc:pagename-accounts "Accounts")) (currency (get-option gnc:pagename-general "Report's currency")) (report-title (get-option gnc:pagename-general gnc:optname-reportname)) (price-source 'pricedb-nearest) ;; Always use the price nearest to the time we're checking for, otherwise we won't get deltas... (include-empty (get-option gnc:pagename-accounts optname-zero-shares)) ;; document will be the HTML document that we return. (table (gnc:make-html-table)) (chart (if show-chart (gnc:make-html-chart) #nil)) (document (gnc:make-html-document)) ) (gnc:html-document-set-title! document (string-append report-title (format #f " ~a" (qof-print-date enddate)))) (if (not (null? accounts)) (let* ( (commodity-list (gnc:accounts-get-commodities (gnc:accounts-and-all-descendants accounts) currency)) (pricedb (gnc-pricedb-get-db (gnc-get-current-book))) (price-fn (lambda (foreign date) (let* ( ;; First look for a price that's before the timestamp, so that we avoid incorrect calculations on splits/mergers (where the timestamp before the ;; split would use a value from after the split, which would then be multiplied by the split factor). Use the end of the day so that we include ;; every action that may have occured on that day. (price (gnc-pricedb-lookup-nearest-before-any-currency-t64 pricedb foreign (gnc:time64-end-day-time date))) ;; If there is no price known before the timestamp, look for the nearest one (i.e. look after the timestamp) (price (if (and price (> (length price) 0)) price (gnc-pricedb-lookup-nearest-in-time-any-currency-t64 pricedb foreign (gnc:time64-end-day-time date)))) (fn (if (and price (> (length price) 0)) (let* ( (the_price (if (gnc-commodity-equiv foreign (gnc-price-get-commodity (car price))) (car price) (gnc-price-invert (car price)) ) ) (v (gnc-price-get-value (car price))) ) (gnc-price-ref (car price)) (cons (car price) v) ) (cons #f (gnc-numeric-zero)) ) ) ) (if price (gnc-price-list-destroy price)) fn ) ) ) (header-list (list (G_ "Account"))) (interval-dates (gnc:make-date-list begindate enddate stepsize)) ) ;; Prepare the chart (if show-chart (begin (gnc:html-chart-set-type! chart 'line) (gnc:html-chart-set-data-labels! chart (map qof-print-date (cdr interval-dates))) (gnc:html-chart-set-grid?! chart chart-grid) (gnc:html-chart-set-width! chart chart-width) (gnc:html-chart-set-height! chart chart-height) (gnc:html-chart-set-currency-symbol! chart "") ) ) ;; Add the static rows - if so requested in the options (if show-symbol (append! header-list (list (G_ "Symbol")))) (if show-listing (append! header-list (list (G_ "Listing")))) ;; Add the date columns (set! header-list (table-add-date-headers header-list (cdr interval-dates))) ;; remove the first interval-date, since we won't have a "previous" value to make a diff with (so we won't include a result in the account rows for that one either) ;; Add the total - if so requested in the options (if show-total (append! header-list (list (G_ "Total")))) ;; Assign the headers to the html table (gnc:html-table-set-col-headers! table header-list) ;; Add the rows for the accounts to the html table and/or the chart (add-stock-rows table chart accounts begindate enddate stepsize currency price-fn include-empty show-symbol show-listing show-total diff-calculation) ;; Add the table to the html document (gnc:html-document-add-object! document table) ;; Add the chart to the document (if show-chart (gnc:html-document-add-object! document chart) ) ) ;if no accounts selected. (gnc:html-document-add-object! document (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj))) ) (gnc:report-finished) document ) ) ) (gnc:define-report 'version 1 'name reportname 'report-guid "9696ee849e1d4233b6fe0b5a39f3a0ab" 'menu-path (list gnc:menuname-asset-liability) 'options-generator options-generator 'renderer commodities-renderer)