diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 57 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | tests/012/seq.tl | 26 | ||||
| -rw-r--r-- | txr.1 | 113 |
6 files changed, 199 insertions, 0 deletions
@@ -6980,6 +6980,7 @@ void eval_init(void) reg_fun(intern(lit("tuples"), user_package), func_n3o(tuples, 2)); reg_fun(intern(lit("tuples*"), user_package), func_n3o(tuples_star, 2)); reg_fun(intern(lit("partition-by"), user_package), func_n2(partition_by)); + reg_fun(intern(lit("partition-if"), user_package), func_n3o(partition_if, 2)); reg_fun(intern(lit("partition"), user_package), func_n2(partition)); reg_fun(intern(lit("split"), user_package), func_n2(split)); reg_fun(intern(lit("split*"), user_package), func_n2(split_star)); @@ -3696,6 +3696,63 @@ val partition_by(val func, val seq) funcall1(func, car(seq)), seq); } +static val partition_if_countdown_funv(val envcons, struct args *args) +{ + cons_bind(count, targetfun, envcons); + val ret; + if (zerop(count)) + return nil; + if ((ret = generic_funcall(targetfun, args))) + rplaca(envcons, pred(count)); + return ret; +} + +static val partition_if_func(val func, val lcons) +{ + list_collect_decl (out, ptail); + us_cons_bind (prev_item, iter, lcons); + + ptail = list_collect(ptail, prev_item); + + while (iter_more(iter)) { + val next_item = iter_item(iter); + val different = funcall2(func, prev_item, next_item); + prev_item = next_item; + if (different) + break; + ptail = list_collect(ptail, next_item); + iter = iter_step(iter); + } + + us_rplacd(lcons, if2(iter_more(iter), + make_lazy_cons_car_cdr(us_lcons_fun(lcons), + prev_item, iter_step(iter)))); + us_rplaca(lcons, make_like(out, iter)); + return nil; +} + +val partition_if(val func, val seq, val count_in) +{ + val self = lit("partition-if"); + val iter = iter_begin(seq); + + if (count_in == zero) { + return cons(seq, nil); + } else if (iter_more(iter)) { + val item = iter_item(iter); + if (!missingp(count_in)) { + if (!integerp(count_in) && !plusp(count_in)) + uw_throwf(type_error_s, lit("~a: count ~s isn't a nonnegative integer"), + self, count_in, nao); + func = func_f0v(cons(count_in, func), partition_if_countdown_funv); + } + return make_lazy_cons_car_cdr(func_f1(func, partition_if_func), + item, iter_step(iter)); + } else { + return nil; + } +} + static val partition_func(val base, val lcons) { us_cons_bind (seq, indices, lcons); @@ -688,6 +688,7 @@ val lazy_flatcar(val tree); val tuples(val n, val seq, val fill); val tuples_star(val n, val seq, val fill); val partition_by(val func, val seq); +val partition_if(val func, val seq, val count_in); val partition(val seq, val indices); val split(val seq, val indices); val partition_star(val seq, val indices); diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index d2af2cc1..7a9348ee 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1408,6 +1408,7 @@ ("partition" "N-0142889E") ("partition*" "N-03951D7A") ("partition-by" "N-000167DF") + ("partition-if" "N-017167C1") ("passwd" "N-036B0636") ("path-blkdev-p" "N-00198FC7") ("path-cat" "N-0033B27E") diff --git a/tests/012/seq.tl b/tests/012/seq.tl index 3c56dfda..1706e6df 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -458,3 +458,29 @@ (find-max-key nil) nil [find-max-key '("alpha" "charlie" "aardvark" "bravo") less upcase-str] "AARDVARK" [find-max-key #H(() (a 1) (b 2) (c 3)) : cdr] 3) + +(defvarl fn (do and + (chr-isdigit @1) + (not (chr-isdigit @2)))) + +(mtest + [partition-if tf nil] nil + [partition-if tf "abc"] ("a" "b" "c") + [partition-if nilf "abc"] ("abc") + [partition-if neql "aaaabbcdee"] ("aaaa" "bb" "c" "d" "ee") + (partition-if fn "a13cd9foo42z") ("a13" "cd9" "foo42" "z")) + +(mtest + (partition-if (op /= (- @2 @1) 1) + '(1 3 4 5 7 8 9 10 9 8 6 5 3 2)) + ((1) (3 4 5) (7 8 9 10) (9) (8) (6) (5) (3) (2)) + (partition-if (op > (abs (- @2 @1)) 1) + '(1 3 4 5 7 8 9 10 9 8 6 5 3 2)) + ((1) (3 4 5) (7 8 9 10 9 8) (6 5) (3 2))) + +(mtest + [partition-if neql "aaaabbcdee" 2] ("aaaa" "bb" "cdee") + [partition-if neql "aaaabbcdee" 1] ("aaaa" "bbcdee") + [partition-if fn "a13cd9foo42z" 2] ("a13" "cd9" "foo42z") + [partition-if fn "a13cd9foo42z" 1] ("a13" "cd9foo42z") + [partition-if fn "a13cd9foo42z" 0] ("a13cd9foo42z")) @@ -37158,6 +37158,119 @@ function. #(4 5 6 7)) .brev +.coNP Function @ partition-if +.synb +.mets (partition-if < function < iterable <> [ count ]) +.syne +.desc +If +.meta sequence +is empty, then +.code partition-if +returns an empty list, +and +.meta function +is never called. + +Otherwise, +.code partition-if +returns a lazy list of partitions of +.metn iterable . +Partitions are consecutive, nonempty substrings of +.metn iterable , +of the same kind as +.metn iterable . + +The partitioning begins with the first element of +.meta iterable +being placed into a partition. + +The subsequent partitioning is done according to a Boolean +.metn function , +which must accept two arguments. Whenever the function yields true, it +indicates that a partition is to be terminated and a new partition to begin. + +The +.meta count +argument, if present, must be a nonnegative integer. It indicates +a limit on how many partitions will be delimited; after this limit +is reached, the remainder of the +.meta iterable +sequence is placed into a single partition. + +After the first element is placed into a partition, the following +process is repeated until the partition is terminated. +.RS +.IP 1. +If +.meta iterable +contains no more elements, then the partition terminates. +.IP 2. +Otherwise, if the +.meta count +is present, and has a value of zero, then the next available +element is unconditionally deposited into the current partition. +.IP 3. +Otherwise, +.meta function +is invoked on two values: the previous element which has most +recently been deposited into the partition, and its successor from +.metn iterable . +.IP 4. +If +.meta function +returns +.codn nil , +then the partition continues: the next element is +added to the partition, and the process repeats from step 1. +.IP 5. +Otherwise, +.meta function +has returned true and the partition is terminated. In this case, if +.meta count +is present, it is decremented. +.RE +.IP +When the current partition is terminated, it is converted to a sequence of the +same kind as +.meta iterable +as if by using the +.code make-like +function, and appended to the lazy list of partitions. If a next element is +available, it is place into a new partition, and the above process takes place +from step 1. + +.TP* Examples: + +.verb + ;; Start new partition for unequal characters. + [partition-if neql "aaaabbcdee"] -> ("aaaa" "bb" "c" "d" "ee") + + ;; As above, but partition only twice + [partition-if neql "aaaabbcdee" 2] -> ("aaaa" "bb" "cdee") + + ;; Start new partition when non-digit follows digit: + [partition-if (do and + (chr-isdigit @1) + (not (chr-isdigit @2))) + "a13cd9foo42z"] + -> ("a13" "cd9" "foo42" "z") + + ;; Place ascending runs of consecutive integers + ;; into partitions. I.e. start a partition whenever the + ;; difference from the previous element isn't 1: + (partition-if (op /= (- @2 @1) 1) + '(1 3 4 5 7 8 9 10 9 8 6 5 3 2)) + -> ((1) (3 4 5) (7 8 9 10) (9) (8) (6) (5) (3) (2)) + + ;; Place runs of adjacent integers into partitions. + ;; I.e. start a new partition if the the absolute value of + ;; the difference from the previous exceeds 1: + (partition-if (op > (abs (- @2 @1)) 1) + '(1 3 4 5 7 8 9 10 9 8 6 5 3 2)) + -> ((1) (3 4 5) (7 8 9 10 9 8) (6 5) (3 2)) +.brev + .SS* Open Sequence Traversal Functions in this category perform efficient traversal of sequences. |