r19253 - gnucash/trunk/src/report/standard-reports - Add averaging option (but currently deactivated) for monthly or weekly average in account piechart.

[Christian Stimming]

Author: cstim
Date: 2010-06-12 11:51:53 -0400 (Sat, 12 Jun 2010)
New Revision: 19253
Trac: http://svn.gnucash.org/trac/changeset/19253

Modified:
   gnucash/trunk/src/report/standard-reports/account-piecharts.scm
Log:
Add averaging option (but currently deactivated) for monthly or weekly average in account piechart.

Will be activated once we're out of string freeze in order not to have
untranslated strings show up for the user.

Modified: gnucash/trunk/src/report/standard-reports/account-piecharts.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/account-piecharts.scm	2010-06-12 15:51:40 UTC (rev 19252)
+++ gnucash/trunk/src/report/standard-reports/account-piecharts.scm	2010-06-12 15:51:53 UTC (rev 19253)
@@ -74,6 +74,9 @@
 (define optname-plot-height (N_ "Plot Height"))
 (define optname-sort-method (N_ "Sort Method"))
 
+(define optname-averaging (N_ "Show Average"))
+(define opthelp-averaging (N_ "Select whether the amounts should be shown over the full time period or rather as the average e.g. per month"))
+
 ;; The option-generator. The only dependance on the type of piechart
 ;; is the list of account types that the account selection option
 ;; accepts.
@@ -101,6 +104,33 @@
      options gnc:pagename-general
      optname-price-source "c" 'average-cost)
 
+    (if #f
+;; Option deactivated before 2.4.0 is out in order not to have
+;; untranslated strings show up for the user (string freeze). Will be
+;; activated in 2.4.1 or so by un-commenting the line below and
+;; removing the line above.
+    ;;(if do-intervals?
+        (add-option
+         (gnc:make-multichoice-option
+          gnc:pagename-general optname-averaging
+          "f" opthelp-averaging
+          'None
+          (list (vector 'None
+                        (N_ "No Averaging")
+                        (N_ "Just show the amounts, without any averaging"))
+                (vector 'YearDelta
+                        (N_ "Yearly")
+                        (N_ "Show the average yearly amount during the reporting period"))
+                (vector 'MonthDelta
+                        (N_ "Monthly")
+                        (N_ "Show the average monthly amount during the reporting period"))
+                (vector 'WeekDelta
+                        (N_ "Weekly")
+                        (N_ "Show the average weekly amount during the reporting period"))
+                )
+          ))
+        )
+
     (add-option
      (gnc:make-account-list-option
       gnc:pagename-accounts optname-accounts
@@ -184,6 +214,10 @@
                                   optname-price-source))
         (report-title (get-option gnc:pagename-general 
 				  gnc:optname-reportname))
+        (averaging-selection (if do-intervals?
+                                 (get-option gnc:pagename-general
+                                             optname-averaging)
+                                 'None))
 
         (show-fullname? (get-option gnc:pagename-display optname-fullname))
         (show-total? (get-option gnc:pagename-display optname-show-total))
@@ -225,6 +259,30 @@
            (tree-depth (if (equal? account-levels 'all)
                            (gnc:get-current-account-tree-depth)
                            account-levels))
+           (averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
+           (averaging-multiplier
+            (if averaging-fraction-func
+                ;; Calculate the divisor of the amounts so that an
+                ;; average is shown
+                (let* ((start-frac (averaging-fraction-func (gnc:timepair->secs from-date-tp)))
+                       (end-frac (averaging-fraction-func (+ 1 (gnc:timepair->secs to-date-tp))))
+                       (diff (- end-frac start-frac))
+                       )
+                  ;; Extra sanity check to ensure a positive number
+                  (if (> diff 0)
+                      (/ 1 diff)
+                      1))
+                ;; No interval-report, or no averaging interval chosen,
+                ;; so just use the multiplier one
+                1))
+           ;; If there is averaging, the report-title is extended
+           ;; accordingly.
+           (report-title
+            (case averaging-selection
+              ('YearDelta (string-append report-title " " (_ "Yearly Average")))
+              ('MonthDelta (string-append report-title " " (_ "Monthly Average")))
+              ('WeekDelta (string-append report-title " " (_ "Weekly Average")))
+              (else report-title)))
            (combined '())
            (other-anchor "")
            (print-info (gnc-commodity-print-info report-currency #t)))
@@ -232,18 +290,23 @@
       ;; Converts a commodity-collector into one single double
       ;; number, depending on the report currency and the
       ;; exchange-fn calculated above. Returns the absolute value
-      ;; as double.
+      ;; as double, multiplied by the averaging-multiplies (smaller
+      ;; than one; multiplication instead of division to avoid
+      ;; division-by-zero issues) in case the user wants to see the
+      ;; amounts averaged over some value.
       (define (collector->double c)
         ;; Future improvement: Let the user choose which kind of
         ;; currency combining she want to be done. Right now
         ;; everything foreign gets converted
         ;; (gnc:sum-collector-commodity) based on the average
         ;; cost of all holdings.
-        (gnc-numeric-to-double
-         (gnc:gnc-monetary-amount
-          (gnc:sum-collector-commodity 
-           c report-currency 
-           exchange-fn))))
+        (*
+         (gnc-numeric-to-double
+          (gnc:gnc-monetary-amount
+           (gnc:sum-collector-commodity 
+            c report-currency 
+            exchange-fn)))
+         averaging-multiplier))
 
       (define (count-accounts current-depth accts)
 	(if (< current-depth tree-depth)