[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/dash 51a07b1 408/439: Merge pull request #127 from occi
From: |
Phillip Lord |
Subject: |
[elpa] externals/dash 51a07b1 408/439: Merge pull request #127 from occidens/fixfn |
Date: |
Tue, 04 Aug 2015 20:31:20 +0000 |
branch: externals/dash
commit 51a07b103d187dc3568fe764f9232f6dfc3ac0d5
Merge: 1fde888 3992e3c
Author: Magnar Sveen <address@hidden>
Commit: Magnar Sveen <address@hidden>
Merge pull request #127 from occidens/fixfn
Make `fixfn' more robust at handling floats
---
README.md | 30 +++++++++++++++++++---
dash-functional.el | 63 ++++++++++++++++++++++++++++++++++++++++------
dev/examples-to-docs.el | 12 ++++++--
dev/examples-to-tests.el | 2 +
dev/examples.el | 23 +++++++++++++---
5 files changed, 110 insertions(+), 20 deletions(-)
diff --git a/README.md b/README.md
index 8cac2de..23d7133 100644
--- a/README.md
+++ b/README.md
@@ -254,7 +254,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
@@ -1483,6 +1483,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)`
@@ -2094,17 +2095,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-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 40e177c..1cd9436 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
@@ -954,10 +965,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")
@@ -982,5 +995,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:
- [elpa] externals/dash c61113b 420/439: [-let] Update outdated comment, (continued)
- [elpa] externals/dash c61113b 420/439: [-let] Update outdated comment, Phillip Lord, 2015/08/04
- [elpa] externals/dash 733274f 398/439: Merge pull request #120 from holomorph/info-manual, Phillip Lord, 2015/08/04
- [elpa] externals/dash a803dd5 414/439: Merge readme changes, Phillip Lord, 2015/08/04
- [elpa] externals/dash 7bd6b3b 400/439: Add dir entry to texinfo template, Phillip Lord, 2015/08/04
- [elpa] externals/dash 5219ac0 422/439: [-let] Eliminate useless re-binding of symbols when sources are immutable, Phillip Lord, 2015/08/04
- [elpa] externals/dash 0ef7384 395/439: Merge pull request #114 from fbergroth/update-test-case, Phillip Lord, 2015/08/04
- [elpa] externals/dash 349931e 399/439: Add @holomorph to list of contributors, Phillip Lord, 2015/08/04
- [elpa] externals/dash 1d4881f 413/439: Update README, Phillip Lord, 2015/08/04
- [elpa] externals/dash 36b7f49 419/439: [-let] Reuse the ignore-place predicate, Phillip Lord, 2015/08/04
- [elpa] externals/dash b308794 416/439: [Fix #73] Add a mention of -filter to -keep docstring, Phillip Lord, 2015/08/04
- [elpa] externals/dash 51a07b1 408/439: Merge pull request #127 from occidens/fixfn,
Phillip Lord <=
- [elpa] externals/dash 8530742 410/439: Add @wasamasa and @occidens to list of contributors, Phillip Lord, 2015/08/04
- [elpa] externals/dash db784f8 403/439: Merge pull request #124 from occidens/skiptests, Phillip Lord, 2015/08/04
- [elpa] externals/dash 9ebd172 421/439: [-let] Generate differently named symbols for temporary sources (makes, Phillip Lord, 2015/08/04
- [elpa] externals/dash 7d7a457 402/439: Allow run-tests.sh to skip tests, Phillip Lord, 2015/08/04
- [elpa] externals/dash 3a3f528 396/439: Add info manual, Phillip Lord, 2015/08/04
- [elpa] externals/dash 4bd6273 397/439: Invoke makeinfo on the generated .texi, Phillip Lord, 2015/08/04
- [elpa] externals/dash cf7ca23 415/439: [Fix #97] Add -remove-item, Phillip Lord, 2015/08/04
- [elpa] externals/dash 90056bd 401/439: Merge pull request #121 from holomorph/master, Phillip Lord, 2015/08/04
- [elpa] externals/dash 3992e3c 406/439: Make `-fixfn' more robust at handling floats, Phillip Lord, 2015/08/04
- [elpa] externals/dash 1fde888 407/439: Merge pull request #125 from wasamasa/feature-some, Phillip Lord, 2015/08/04