summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--eval.c1
-rw-r--r--lib.c57
-rw-r--r--lib.h1
-rw-r--r--stdlib/doc-syms.tl1
-rw-r--r--tests/012/seq.tl26
-rw-r--r--txr.1113
6 files changed, 199 insertions, 0 deletions
diff --git a/eval.c b/eval.c
index 3d0db78c..a1fc263a 100644
--- a/eval.c
+++ b/eval.c
@@ -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));
diff --git a/lib.c b/lib.c
index 2d331a9f..fecb68c2 100644
--- a/lib.c
+++ b/lib.c
@@ -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);
diff --git a/lib.h b/lib.h
index 817e8d87..0bc7013e 100644
--- a/lib.h
+++ b/lib.h
@@ -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"))
diff --git a/txr.1 b/txr.1
index fb8c7bfb..ac7abd73 100644
--- a/txr.1
+++ b/txr.1
@@ -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.