* guile: some internal improvements

This commit is contained in:
djcb 2012-07-12 15:46:19 +03:00
parent 62489a31d0
commit c2676540d0
3 changed files with 59 additions and 39 deletions

View File

@ -29,7 +29,7 @@ Sun..Sat) that match EXPR. If PLAIN-TEXT is true, use a plain-text
display, otherwise, use a graphical window." display, otherwise, use a graphical window."
(mu:plot (mu:plot
(sort (sort
(mu:tabulate-messages (mu:tabulate
(lambda (msg) (lambda (msg)
(tm:hour (localtime (mu:date msg)))) expr) (tm:hour (localtime (mu:date msg)))) expr)
(lambda (x y) (< (car x) (car y)))) (lambda (x y) (< (car x) (car y))))
@ -41,7 +41,7 @@ Sun..Sat) that match EXPR. If PLAIN-TEXT is true, use a plain-text
display, otherwise, use a graphical window." display, otherwise, use a graphical window."
(mu:plot (mu:plot
(mu:weekday-numbers->names (mu:weekday-numbers->names
(sort (mu:tabulate-messages (sort (mu:tabulate
(lambda (msg) (lambda (msg)
(tm:wday (localtime (mu:date msg)))) expr) (tm:wday (localtime (mu:date msg)))) expr)
(lambda (x y) (< (car x) (car y))))) (lambda (x y) (< (car x) (car y)))))
@ -54,7 +54,7 @@ display, otherwise, use a graphical window."
(mu:plot (mu:plot
(mu:month-numbers->names (mu:month-numbers->names
(sort (sort
(mu:tabulate-messages (mu:tabulate
(lambda (msg) (lambda (msg)
(tm:mon (localtime (mu:date msg)))) expr) (tm:mon (localtime (mu:date msg)))) expr)
(lambda (x y) (< (car x) (car y))))) (lambda (x y) (< (car x) (car y)))))
@ -66,10 +66,10 @@ display, otherwise, use a graphical window."
Sun..Sat) that match EXPR. If PLAIN-TEXT is true, use a plain-text Sun..Sat) that match EXPR. If PLAIN-TEXT is true, use a plain-text
display, otherwise, use a graphical window." display, otherwise, use a graphical window."
(mu:plot (mu:plot
(sort (mu:tabulate-messages (sort (mu:tabulate
(lambda (msg) (lambda (msg)
(string->number (string->number
(format #f "~d~2'0d" (format #f "~d~2'0d"
(+ 1900 (tm:year (localtime (mu:date msg)))) (+ 1900 (tm:year (localtime (mu:date msg))))
(tm:mon (localtime (mu:date msg)))))) (tm:mon (localtime (mu:date msg))))))
expr) expr)
@ -84,7 +84,7 @@ display, otherwise, use a graphical window."
Sun..Sat) that match EXPR. If PLAIN-TEXT is true, use a plain-text Sun..Sat) that match EXPR. If PLAIN-TEXT is true, use a plain-text
display, otherwise, use a graphical window." display, otherwise, use a graphical window."
(mu:plot (mu:plot
(sort (mu:tabulate-messages (sort (mu:tabulate
(lambda (msg) (lambda (msg)
(+ 1900 (tm:year (localtime (mu:date msg))))) expr) (+ 1900 (tm:year (localtime (mu:date msg))))) expr)
(lambda (x y) (< (car x) (car y)))) (lambda (x y) (< (car x) (car y))))
@ -118,7 +118,7 @@ display, otherwise, use a graphical window."
((string= what "per-hour") (per-hour expr text)) ((string= what "per-hour") (per-hour expr text))
((string= what "per-day") (per-day expr text)) ((string= what "per-day") (per-day expr text))
((string= what "per-month") (per-month expr text)) ((string= what "per-month") (per-month expr text))
((string= what "per-year-month") (per-year-month expr text)) ((string= what "per-year-month") (per-year-month expr text))
((string= what "per-year") (per-year expr text)) ((string= what "per-year") (per-year expr text))
(else (begin (else (begin
(display msg) (display msg)

View File

@ -1,4 +1,4 @@
\input texinfo.tex @c -*-texinfo-*- \\input texinfo.tex @c -*-texinfo-*-
@c %**start of header @c %**start of header
@setfilename mu-guile.info @setfilename mu-guile.info
@settitle mu-guile user manual @settitle mu-guile user manual
@ -663,7 +663,7 @@ probably be a bit more elegant.
@t{mu-guile} offers some convenience functions to determine various statistics @t{mu-guile} offers some convenience functions to determine various statistics
about the messages in the database. about the messages in the database.
@code{(mu:tabulate-messages <function> [<search-expr>])} applies @code{(mu:tabulate <function> [<search-expr>])} applies
@t{<function>} to each message matching @t{<search-expr>} (leave empty to @t{<function>} to each message matching @t{<search-expr>} (leave empty to
match @emph{all} messages), and returns a associative list (a list of pairs) match @emph{all} messages), and returns a associative list (a list of pairs)
with each of the different results of @t{<function>} and their frequencies. with each of the different results of @t{<function>} and their frequencies.
@ -683,7 +683,7 @@ exec guile -s $0 $@
(define weekday-table (define weekday-table
(mu:weekday-numbers->names (mu:weekday-numbers->names
(sort (sort
(mu:tabulate-messages (mu:tabulate
(lambda (msg) (lambda (msg)
(tm:wday (localtime (mu:date msg))))) (tm:wday (localtime (mu:date msg)))))
(lambda (a b) (< (car a) (car b)))))) (lambda (a b) (< (car a) (car b))))))
@ -751,7 +751,7 @@ exec guile -s $0 $@
(define (mail-per-hour-table) (define (mail-per-hour-table)
(sort (sort
(mu:tabulate-messages (mu:tabulate
(lambda (msg) (lambda (msg)
(tm:hour (localtime (mu:date msg))))) (tm:hour (localtime (mu:date msg)))))
(lambda (x y) (< (car x) (car y))))) (lambda (x y) (< (car x) (car y)))))

View File

@ -21,17 +21,22 @@
:use-module (mu message) :use-module (mu message)
:use-module (srfi srfi-1) :use-module (srfi srfi-1)
:use-module (ice-9 i18n) :use-module (ice-9 i18n)
:export ( mu:tabulate-messages :use-module (ice-9 r5rs)
mu:average-messages :export ( mu:tabulate
mu:average
mu:stddev
mu:weekday-numbers->names mu:weekday-numbers->names
mu:month-numbers->names)) mu:month-numbers->names))
(define* (mu:tabulate-messages func #:optional (expr #t))
(define* (mu:tabulate func #:optional (expr #t))
"Execute FUNC for each message matching EXPR, and return an alist "Execute FUNC for each message matching EXPR, and return an alist
with maps each result of FUNC to its frequency. FUNC is a function with maps each result of FUNC to its frequency. FUNC is a function
takes a <mu-message> instance as its argument. For example, to takes a <mu-message> instance as its argument. For example, to
tabulate messages by weekday, one could use: tabulate messages by weekday, one could use:
(mu:tabulate-messages (lambda(msg) (tm:wday (localtime (date msg)))))." (mu:tabulate (lambda(msg) (tm:wday (localtime (date msg))))), and
get back a list like
((1 . 2) (2 . 5)(3 . 4)(4 . 4)(5 . 12)(6 . 7)(7. 2))."
(let ((table '())) (let ((table '()))
(mu:for-each-message (mu:for-each-message
(lambda(msg) (lambda(msg)
@ -41,34 +46,52 @@ tabulate messages by weekday, one could use:
expr) expr)
table)) table))
(define (average lst)
"Calculate the average of a list LST of numbers, or #f if undefined."
(if (null? lst)
#f
(/ (apply + lst) (length lst))))
(define (stddev lst)
"Calculate the standard deviation of a list LST of numbers or #f if
undefined."
(let* ((avg (average lst))
(sosq (if avg
(apply + (map (lambda (x)(* (- x avg) (- x avg))) lst)))))
(if sosq
(sqrt (/ sosq (length lst))))))
(define* (mu:average func #:optional (expr #t))
"Get the average value of FUNC applied to all messages matching
EXPR (or #t for all). Returns #f if undefined."
(average (map func (mu:message-list expr))))
(define* (mu:stddev func #:optional (expr #t))
"Get the standard deviation for the the values of FUNC applied to
all messages matching EXPR (or #t for all). Returns #f if undefined."
(stddev (map func (mu:message-list expr))))
(define* (mu:max func #:optional (expr #t))
"Get the maximum value of FUNC applied to all messages matching
EXPR (or #t for all). Returns #f if undefined."
(apply max (map func (mu:message-list expr))))
(define* (mu:min func #:optional (expr #t))
"Get the minimum value of FUNC applied to all messages matching
EXPR (or #t for all). Returns #f if undefined."
(apply min (map func (mu:message-list expr))))
(define* (mu:average-messages func #:optional (expr #t))
"Execute FUNC for each message matching EXPR, and return the average
value of the results of FUNC. FUNC is a function that takes a
<mu-message> instance as its argument, and returns some number. For
example, to get the average message size of messages related to
icecream: (mu:average (lambda(msg) (size msg)) \"icecream\" ."
(let ((count 0) (sum 0))
(mu:for-each-message
(lambda (msg)
(set! count (+1 count))
(set! sum (+ sum (func msg))))
expr)
(if (= count 0)
0
(exact->inexact (/ sum count)))))
;; a list of abbreviated, localized day names ;; a list of abbreviated, localized day names
(define day-names (define day-names
(map (map locale-day-short (iota 7 1)))
(lambda (num)
(locale-day-short num))
(iota 7 1)))
(define (mu:weekday-numbers->names table) (define (mu:weekday-numbers->names table)
"Convert a list of pairs with the car denoting a day number (0-6) "Convert a list of pairs with the car denoting a day number (0-6)
into a list of pairs with the car replaced by the corresponding day into a list of pairs with the car replaced by the corresponding day
name (abbreviated)." name (abbreviated) for the current locale."
(map (map
(lambda (pair) (lambda (pair)
(cons (list-ref day-names (car pair)) (cdr pair))) (cons (list-ref day-names (car pair)) (cdr pair)))
@ -76,10 +99,7 @@ name (abbreviated)."
;; a list of abbreviated, localized month names ;; a list of abbreviated, localized month names
(define month-names (define month-names
(map (map locale-month-short (iota 12 1)))
(lambda (num)
(locale-month-short num))
(iota 12 1)))
(define (mu:month-numbers->names table) (define (mu:month-numbers->names table)
"Convert a list of pairs with the car denoting a month number (0-11) "Convert a list of pairs with the car denoting a month number (0-11)