From 4640a2a51cba13b935b3670fd4e0c054342aaf2d Mon Sep 17 00:00:00 2001 From: William West Date: Wed, 11 Mar 2015 22:47:17 -0400 Subject: [PATCH 1/2] Allow for approx comparison of floats in tests defexample entries may now include a symbol `~>' instead of `=>' which uses an approximate comparison instead of `equal' to compare actual and expected floating-point values. Also, for completeness, add support for the `should-error' symbol `!!>' in `examples-to-docs.el'. This is formatted as the comment ";; Error" --- dev/examples-to-docs.el | 12 +++++++++--- dev/examples-to-tests.el | 2 ++ dev/examples.el | 13 ++++++++++++- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/dev/examples-to-docs.el b/dev/examples-to-docs.el index 6d5044e..f40ce5b 100644 --- a/dev/examples-to-docs.el +++ b/dev/examples-to-docs.el @@ -5,9 +5,15 @@ (defvar functions '()) (defun example-to-string (example) - (let ((actual (car example)) - (expected (nth 2 example))) - (--> (format "%S ;; => %S" actual expected) + (-let* (((actual sym expected) example) + (comment + (cond + ((eq sym '=>) (format "=> %S" expected)) + ((eq sym '~>) (format "~> %S" expected)) + ((eq sym '!!>) (format "Error")) + (t (error "Invalid test case: %S" `(,actual ,sym ,expected)))))) + (--> comment + (format "%S ;; %s" actual it) (replace-regexp-in-string "\\\\\\?" "?" it) (replace-regexp-in-string "\n" "\\n" it t t) (replace-regexp-in-string "\t" "\\t" it t t) diff --git a/dev/examples-to-tests.el b/dev/examples-to-tests.el index 49d6649..bd01637 100644 --- a/dev/examples-to-tests.el +++ b/dev/examples-to-tests.el @@ -3,6 +3,8 @@ (defun example-to-should (actual sym expected) (cond ((eq sym '=>) `(should (equal ,actual ,expected))) + ((eq sym '~>) + `(should (approx-equal ,actual ,expected))) ((eq sym '!!>) `(should-error (eval ',actual) :type ',expected)) (t diff --git a/dev/examples.el b/dev/examples.el index 79ac244..ac09d16 100644 --- a/dev/examples.el +++ b/dev/examples.el @@ -9,6 +9,17 @@ (defun square (num) (* num num)) (defun three-letters () '("A" "B" "C")) +;; Allow approximate comparison of floating-point results, to work +;; around differences in implementation between systems. Use the `~>' +;; symbol instead of `=>' to test the expected and actual values with +;; `approx-equal' +(defvar epsilon 1e-15) +(defun approx-equal (u v) + (or (= u v) + (< (/ (abs (- u v)) + (max (abs u) (abs v))) + epsilon))) + (def-example-group "Maps" "Functions in this category take a transforming function, which is then applied sequentially to each or selected elements of the @@ -977,5 +988,5 @@ new list." (funcall (-prodfn (-compose f ff) (-compose g gg)) input3)))) => t))) ;; Local Variables: -;; eval: (font-lock-add-keywords nil '(("defexamples\\|def-example-group\\| => \\| !!> " (0 'font-lock-keyword-face)) ("(defexamples[[:blank:]]+\\(.*\\)" (1 'font-lock-function-name-face)))) +;; eval: (font-lock-add-keywords nil '(("defexamples\\|def-example-group\\| => \\| !!> \\| ~>" (0 'font-lock-keyword-face)) ("(defexamples[[:blank:]]+\\(.*\\)" (1 'font-lock-function-name-face)))) ;; End: From 3992e3c506f1355aed287eccad9b71538e7080ea Mon Sep 17 00:00:00 2001 From: William West Date: Wed, 11 Mar 2015 22:51:47 -0400 Subject: [PATCH 2/2] Make `-fixfn' more robust at handling floats This change addreses issue #123. The two new optional parameters to `-fixfn' allow the caller to specify a custom equality test function, such as an approximate comparison of floats, and a halt test function, which can trigger a halt to the fixpoint iteration if it fails to converge. The default equality test remains `equal'. The default halt test is a simple counter up to `-fixfn-max-iterations'. The counter is provided by the new function `-counter'. The revised tests illustrate the usage of the new parameters. --- README.md | 30 +++++++++++++++++++--- dash-functional.el | 63 ++++++++++++++++++++++++++++++++++++++++------ dev/examples.el | 10 +++++--- 3 files changed, 87 insertions(+), 16 deletions(-) diff --git a/README.md b/README.md index 91f0799..f4999b6 100644 --- a/README.md +++ b/README.md @@ -253,7 +253,7 @@ These combinators require Emacs 24 for its lexical scope. So they are offered in * [-orfn](#-orfn-rest-preds) `(&rest preds)` * [-andfn](#-andfn-rest-preds) `(&rest preds)` * [-iteratefn](#-iteratefn-fn-n) `(fn n)` -* [-fixfn](#-fixfn-fn) `(fn)` +* [-fixfn](#-fixfn-fn-optional-equal-test-halt-test) `(fn &optional equal-test halt-test)` * [-prodfn](#-prodfn-rest-fns) `(&rest fns)` ## Anaphoric functions @@ -1470,6 +1470,7 @@ not, return a list with `args` as elements. ```el (-list 1) ;; => '(1) (-list 1 2 3) ;; => '(1 2 3) +(-list '(1 2 3)) ;; => '(1 2 3) ``` #### -fix `(fn list)` @@ -2081,17 +2082,38 @@ This function satisfies the following law: (funcall (-iteratefn 'cdr 3) '(1 2 3 4 5)) ;; => '(4 5) ``` -#### -fixfn `(fn)` +#### -fixfn `(fn &optional equal-test halt-test)` Return a function that computes the (least) fixpoint of `fn`. -`fn` is a unary function, results are compared with `equal`. +`fn` must be a unary function. The returned lambda takes a single +argument, `x`, the initial value for the fixpoint iteration. The +iteration halts when either of the following conditions is satisified: + + 1. Iteration converges to the fixpoint, with equality being + tested using `equal-test`. If `equal-test` is not specified, + `equal` is used. For functions over the floating point + numbers, it may be necessary to provide an appropriate + appoximate comparsion test. + + 2. `halt-test` returns a non-nil value. `halt-test` defaults to a + simple counter that returns t after `-fixfn-max-iterations`, + to guard against infinite iteration. Otherwise, `halt-test` + must be a function that accepts a single argument, the + current value of `x`, and returns non-nil as long as iteration + should continue. In this way, a more sophisticated + convergence test may be supplied by the caller. + +The return value of the lambda is either the fixpoint or, if +iteration halted before converging, a cons with car `halted` and +cdr the final output from `halt-test`. In types: (a -> a) -> a -> a. ```el -(funcall (-fixfn 'cos) 0.7) ;; => 0.7390851332151607 +(funcall (-fixfn 'cos 'approx-equal) 0.7) ;; ~> 0.7390851332151607 (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) ;; => 1.8555845286409378 +(funcall (-fixfn 'sin 'approx-equal) 0.1) ;; => '(halted . t) ``` #### -prodfn `(&rest fns)` diff --git a/dash-functional.el b/dash-functional.el index 225c15d..296ccb1 100644 --- a/dash-functional.el +++ b/dash-functional.el @@ -135,18 +135,65 @@ This function satisfies the following law: (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))." (lambda (x) (--dotimes n (setq x (funcall fn x))) x)) -(defun -fixfn (fn) +(defun -counter (&optional beg end inc) + "Return a closure that counts from BEG to END, with increment INC. + +The closure will return the next value in the counting sequence +each time it is called, and nil after END is reached. BEG +defaults to 0, INC defaults to 1, and if END is nil, the counter +will increment indefinitely. + +The closure accepts any number of arguments, which are discarded." + (let ((inc (or inc 1)) + (n (or beg 0))) + (lambda (&rest _) + (when (or (not end) (< n end)) + (prog1 n + (setq n (+ n inc))))))) + +(defvar -fixfn-max-iterations 1000 + "The default maximum number of iterations performed by `-fixfn' + unless otherwise specified.") + +(defun -fixfn (fn &optional equal-test halt-test) "Return a function that computes the (least) fixpoint of FN. -FN is a unary function, results are compared with `equal'. +FN must be a unary function. The returned lambda takes a single +argument, X, the initial value for the fixpoint iteration. The +iteration halts when either of the following conditions is satisified: + + 1. Iteration converges to the fixpoint, with equality being + tested using EQUAL-TEST. If EQUAL-TEST is not specified, + `equal' is used. For functions over the floating point + numbers, it may be necessary to provide an appropriate + appoximate comparsion test. + + 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a + simple counter that returns t after `-fixfn-max-iterations', + to guard against infinite iteration. Otherwise, HALT-TEST + must be a function that accepts a single argument, the + current value of X, and returns non-nil as long as iteration + should continue. In this way, a more sophisticated + convergence test may be supplied by the caller. + +The return value of the lambda is either the fixpoint or, if +iteration halted before converging, a cons with car `halted' and +cdr the final output from HALT-TEST. In types: (a -> a) -> a -> a." - (lambda (x) - (let ((re (funcall fn x))) - (while (not (equal x re)) - (setq x re) - (setq re (funcall fn re))) - re))) + (let ((eqfn (or equal-test 'equal)) + (haltfn (or halt-test + (-not + (-counter 0 -fixfn-max-iterations))))) + (lambda (x) + (let ((re (funcall fn x)) + (halt? (funcall haltfn x))) + (while (and (not halt?) (not (funcall eqfn x re))) + (setq x re + re (funcall fn re) + halt? (funcall haltfn re))) + (if halt? (cons 'halted halt?) + re))))) (defun -prodfn (&rest fns) "Take a list of n functions and return a function that takes a diff --git a/dev/examples.el b/dev/examples.el index ac09d16..707123e 100644 --- a/dev/examples.el +++ b/dev/examples.el @@ -960,10 +960,12 @@ new list." (-last-item (-iterate fn init (1+ 5)))))) => t) (defexamples -fixfn - ;; Find solution to cos(x) = x - (funcall (-fixfn 'cos) 0.7) => 0.7390851332151607 - ;; Find solution to x^4 - x - 10 = 0 - (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) => 1.8555845286409378) + ;; Find solution to cos(x) = x (may not converge without fuzzy comparison) + (funcall (-fixfn 'cos 'approx-equal) 0.7) ~> 0.7390851332151607 + ;; Find solution to x^4 - x - 10 = 0 (converges using 'equal comparison) + (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) => 1.8555845286409378 + ;; The sin function has a fixpoint at zero, but it converges too slowly and is halted + (funcall (-fixfn 'sin 'approx-equal) 0.1) => '(halted . t)) (defexamples -prodfn (funcall (-prodfn '1+ '1- 'int-to-string) '(1 2 3)) => '(2 1 "3")