Mercurial > hg > xemacs-beta
comparison lisp/cl-seq.el @ 5067:7d7ae8db0341
add functions `stable-union' and `stable-intersection' to do stable set operations
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* cl-seq.el:
* cl-seq.el (stable-union): New.
* cl-seq.el (stable-intersection): New.
New functions to do stable set operations, i.e. preserve the order
of the elements in the argument lists, and prefer LIST1 over LIST2
when ordering the combined result. The result looks as much like
LIST1 as possible, followed (in the case of `stable-union') by
any necessary elements from LIST2, in order. This is contrary to
`union' and `intersection', which are not required to be order-
preserving and are not -- they prefer LIST2 and output results in
backwards order.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 22 Feb 2010 21:23:02 -0600 |
| parents | 545ec923b4eb |
| children | 6afe991b8135 |
comparison
equal
deleted
inserted
replaced
| 5066:545ec923b4eb | 5067:7d7ae8db0341 |
|---|---|
| 848 Keywords supported: :test :test-not :key | 848 Keywords supported: :test :test-not :key |
| 849 See `union' for the meaning of :test, :test-not and :key." | 849 See `union' for the meaning of :test, :test-not and :key." |
| 850 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) | 850 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) |
| 851 (t (apply 'union cl-list1 cl-list2 cl-keys)))) | 851 (t (apply 'union cl-list1 cl-list2 cl-keys)))) |
| 852 | 852 |
| 853 ;; XEmacs addition: NOT IN COMMON LISP. | |
| 854 (defun stable-union (cl-list1 cl-list2 &rest cl-keys) | |
| 855 "Stably combine LIST1 and LIST2 using a set-union operation. | |
| 856 The result list contains all items that appear in either LIST1 or LIST2. | |
| 857 The result is \"stable\" in that it preserves the ordering of elements in | |
| 858 LIST1 and LIST2. The result specifically consists of the elements in LIST1 | |
| 859 in order, followed by any elements in LIST2 that are not also in LIST1, in | |
| 860 the order given in LIST2. | |
| 861 This is a non-destructive function; it makes a copy of the data if necessary | |
| 862 to avoid corrupting the original LIST1 and LIST2. | |
| 863 Keywords supported: :test :test-not :key | |
| 864 See `union' for the meaning of :test, :test-not and :key. | |
| 865 | |
| 866 NOTE: This is *NOT* a function defined by Common Lisp, but an XEmacs | |
| 867 extension." | |
| 868 ;; The standard `union' doesn't produce a "stable" union -- | |
| 869 ;; it iterates over the second list instead of the first one, and returns | |
| 870 ;; the values in backwards order. According to the CLTL2 documentation, | |
| 871 ;; `union' is not required to preserve the ordering of elements in | |
| 872 ;; any fashion, so we add a new function rather than changing the | |
| 873 ;; semantics of `union'. | |
| 874 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) | |
| 875 ((equal cl-list1 cl-list2) cl-list1) | |
| 876 (t | |
| 877 (append | |
| 878 cl-list1 | |
| 879 (cl-parsing-keywords (:key) (:test :test-not) | |
| 880 (loop for cl-l in cl-list2 | |
| 881 if (not (if (or cl-keys (numberp cl-l)) | |
| 882 (apply 'member* (cl-check-key cl-l) | |
| 883 cl-list1 cl-keys) | |
| 884 (memq cl-l cl-list1))) | |
| 885 collect cl-l)))))) | |
| 886 | |
| 853 (defun intersection (cl-list1 cl-list2 &rest cl-keys) | 887 (defun intersection (cl-list1 cl-list2 &rest cl-keys) |
| 854 "Combine LIST1 and LIST2 using a set-intersection operation. | 888 "Combine LIST1 and LIST2 using a set-intersection operation. |
| 855 The result list contains all items that appear in both LIST1 and LIST2. | 889 The result list contains all items that appear in both LIST1 and LIST2. |
| 856 This is a non-destructive function; it makes a copy of the data if necessary | 890 This is a non-destructive function; it makes a copy of the data if necessary |
| 857 to avoid corrupting the original LIST1 and LIST2. | 891 to avoid corrupting the original LIST1 and LIST2. |
| 879 whenever possible. | 913 whenever possible. |
| 880 Keywords supported: :test :test-not :key | 914 Keywords supported: :test :test-not :key |
| 881 See `union' for the meaning of :test, :test-not and :key." | 915 See `union' for the meaning of :test, :test-not and :key." |
| 882 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) | 916 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) |
| 883 | 917 |
| 918 ;; XEmacs addition: NOT IN COMMON LISP. | |
| 919 (defun stable-intersection (cl-list1 cl-list2 &rest cl-keys) | |
| 920 "Stably combine LIST1 and LIST2 using a set-intersection operation. | |
| 921 The result list contains all items that appear in both LIST1 and LIST2. | |
| 922 The result is \"stable\" in that it preserves the ordering of elements in | |
| 923 LIST1 that are also in LIST2. | |
| 924 This is a non-destructive function; it makes a copy of the data if necessary | |
| 925 to avoid corrupting the original LIST1 and LIST2. | |
| 926 Keywords supported: :test :test-not :key | |
| 927 See `union' for the meaning of :test, :test-not and :key. | |
| 928 | |
| 929 NOTE: This is *NOT* a function defined by Common Lisp, but an XEmacs | |
| 930 extension." | |
| 931 ;; The standard `intersection' doesn't produce a "stable" intersection -- | |
| 932 ;; it iterates over the second list instead of the first one, and returns | |
| 933 ;; the values in backwards order. According to the CLTL2 documentation, | |
| 934 ;; `intersection' is not required to preserve the ordering of elements in | |
| 935 ;; any fashion, so we add a new function rather than changing the | |
| 936 ;; semantics of `intersection'. | |
| 937 (and cl-list1 cl-list2 | |
| 938 (if (equal cl-list1 cl-list2) cl-list1 | |
| 939 (cl-parsing-keywords (:key) (:test :test-not) | |
| 940 (loop for cl-l in cl-list1 | |
| 941 if (if (or cl-keys (numberp cl-l)) | |
| 942 (apply 'member* (cl-check-key cl-l) | |
| 943 cl-list2 cl-keys) | |
| 944 (memq cl-l cl-list2)) | |
| 945 collect cl-l))))) | |
| 946 | |
| 884 (defun set-difference (cl-list1 cl-list2 &rest cl-keys) | 947 (defun set-difference (cl-list1 cl-list2 &rest cl-keys) |
| 885 "Combine LIST1 and LIST2 using a set-difference operation. | 948 "Combine LIST1 and LIST2 using a set-difference operation. |
| 886 The result list contains all items that appear in LIST1 but not LIST2. | 949 The result list contains all items that appear in LIST1 but not LIST2. |
| 887 This is a non-destructive function; it makes a copy of the data if necessary | 950 This is a non-destructive function; it makes a copy of the data if necessary |
| 888 to avoid corrupting the original LIST1 and LIST2. | 951 to avoid corrupting the original LIST1 and LIST2. |