diff options
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 42 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 2 | ||||
| -rw-r--r-- | tests/012/seq.tl | 78 | ||||
| -rw-r--r-- | txr.1 | 113 |
6 files changed, 239 insertions, 0 deletions
@@ -7019,6 +7019,8 @@ void eval_init(void) reg_fun(intern(lit("unique"), user_package), func_n2ov(unique, 1)); reg_fun(intern(lit("uniq"), user_package), func_n1(uniq)); reg_fun(intern(lit("grade"), user_package), func_n3o(grade, 1)); + reg_fun(intern(lit("nrot"), user_package), func_n2o(nrot, 1)); + reg_fun(intern(lit("rot"), user_package), func_n2o(rot, 1)); reg_var(intern(lit("*param-macro*"), user_package), pm_table); @@ -10750,6 +10750,48 @@ val grade(val seq, val lessfun, val keyfun_in) return nil; } +val nrot(val seq, val n_in) +{ + val len = length(seq); + + if (len != zero && len != one) { + val n = mod(default_arg(n_in, one), len); + + if (n == one) { + val head = ref(seq, zero); + seq = replace(seq, cons(head, nil), len, len); + seq = replace(seq, nil, zero, one); + } else if (n != zero) { + val head = sub(seq, zero, n); + seq = replace(seq, head, len, len); + seq = replace(seq, nil, zero, n); + } + } + + return seq; +} + +val rot(val seq, val n_in) +{ + val seq_orig = seq; + val len = length(seq); + + if (len != zero && len != one) { + val n = mod(default_arg(n_in, one), len); + + if (n != zero) { + val head = sub(seq, zero, n); + seq = sub(seq, n, t); + seq = replace(seq, head, t, t); + } + } + + if (seq == seq_orig) + seq = copy(seq); + + return seq; +} + val find(val item, val seq, val testfun, val keyfun) { val self = lit("find"); @@ -1183,6 +1183,8 @@ val sort_group(val seq, val keyfun, val lessfun); val unique(val seq, val keyfun, struct args *hashv_args); val uniq(val seq); val grade(val seq, val lessfun, val keyfun_in); +val nrot(val seq, val n_in); +val rot(val seq, val n_in); val find(val list, val key, val testfun, val keyfun); val rfind(val list, val key, val testfun, val keyfun); val find_if(val pred, val list, val key); diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 041314fd..654a3610 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1322,6 +1322,7 @@ ("nr" "N-03A7AE6D") ("nreconc" "N-012FF2DC") ("nreverse" "N-03D8471B") + ("nrot" "N-025DB962") ("nshuffle" "N-01F12561") ("nsort" "N-01FE5176") ("nth" "N-0039F3FB") @@ -1627,6 +1628,7 @@ ("rng" "N-00BEA6DF") ("rng+" "N-00BEA6DF") ("rng-" "N-00BEA6DF") + ("rot" "N-025DB962") ("rotate" "N-0166291D") ("round" "D-0002") ("round-rem" "N-02DE978F") diff --git a/tests/012/seq.tl b/tests/012/seq.tl index ef5fad7c..dadb9e9b 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -309,3 +309,81 @@ (mtest (take 3 (tuples* 3 (range 0))) ((0 1 2) (1 2 3) (2 3 4)) (take 3 (tuples* 3 0)) ((0 1 2) (1 2 3) (2 3 4))) + +(mtest + (nrot nil) nil + (nrot #()) #() + (nrot "") "" + (nrot nil 2) nil + (nrot #() 2) #() + (nrot "" 2) "" + (nrot nil -1) nil + (nrot #() -1) #() + (nrot "" -1) "") + +(mtest + (let ((s '(a))) (nrot s)) (a) + (let ((s #(1))) (nrot s) s) #(1) + (let ((s "x")) (nrot s) s) "x" + (let ((s '(a))) (nrot s -1)) (a) + (let ((s #(1))) (nrot s -1) s) #(1) + (let ((s "x")) (nrot s -1) s) "x") + +(mtest + (let ((s '(a b))) (nrot s)) (b a) + (let ((s #(1 2))) (nrot s) s) #(2 1) + (let ((s "xy")) (nrot s) s) "yx" + (let ((s '(a b))) (nrot s -1)) (b a) + (let ((s #(1 2))) (nrot s -1) s) #(2 1) + (let ((s "xy")) (nrot s -1) s) "yx") + +(mtest + (let ((s '(a b c))) (nrot s)) (b c a) + (let ((s #(1 2 3))) (nrot s) s) #(2 3 1) + (let ((s "xyz")) (nrot s) s) "yzx" + (let ((s '(a b c))) (nrot s -1)) (c a b) + (let ((s #(1 2 3))) (nrot s -1) s) #(3 1 2) + (let ((s "xyz")) (nrot s -1) s) "zxy") + +(mtest + (let ((s '(a b c))) (nrot s 33)) (a b c) + (let ((s '(a b c))) (nrot s 34)) (b c a)) + +(mtest + (rot nil) nil + (rot #()) #() + (rot "") "" + (rot nil 2) nil + (rot #() 2) #() + (rot "" 2) "" + (rot nil -1) nil + (rot #() -1) #() + (rot "" -1) "") + +(mtest + (let ((s '(a))) (list (rot s) s)) ((a) (a)) + (let ((s #(1))) (list (rot s) s)) (#(1) #(1)) + (let ((s "x")) (list (rot s) s)) ("x" "x") + (let ((s '(a))) (list (rot s -1) s)) ((a) (a)) + (let ((s #(1))) (list (rot s -1) s)) (#(1) #(1)) + (let ((s "x")) (list (rot s -1) s)) ("x" "x")) + +(mtest + (let ((s '(a b))) (list (rot s) s)) ((b a) (a b)) + (let ((s #(1 2))) (list (rot s) s)) (#(2 1) #(1 2)) + (let ((s "xy")) (list (rot s) s)) ("yx" "xy") + (let ((s '(a b))) (list (rot s -1) s)) ((b a) (a b)) + (let ((s #(1 2))) (list (rot s -1) s)) (#(2 1) #(1 2)) + (let ((s "xy")) (list (rot s -1) s)) ("yx" "xy")) + +(mtest + (let ((s '(a b c))) (list (rot s) s)) ((b c a) (a b c)) + (let ((s #(1 2 3))) (list (rot s) s)) (#(2 3 1) #(1 2 3)) + (let ((s "xyz")) (list (rot s) s)) ("yzx" "xyz") + (let ((s '(a b c))) (list (rot s -1) s)) ((c a b) (a b c)) + (let ((s #(1 2 3))) (list (rot s -1) s)) (#(3 1 2) #(1 2 3)) + (let ((s "xyz")) (list (rot s -1) s)) ("zxy" "xyz")) + +(mtest + (let ((s '(a b c))) (list (rot s 33) s)) ((a b c) (a b c)) + (let ((s '(a b c))) (list (rot s 34) s)) ((b c a) (a b c))) @@ -35727,6 +35727,119 @@ was introduced in \*(TX 238. Prior to that version, behaved like .codn nshuffle . +.coNP Functions @ rot and @ nrot +.synb +.mets (rot < sequence <> [ displacement ]) +.mets (nrot < sequence <> [ displacement ]) +.syne +.desc +The +.code nrot +and +.code rot +functions rotate the elements of +.metn sequence , +returning a rotated sequence. + +The +.code nrot +function does this destructively; it modifies +.meta sequence +in-place, whereas +.code rot +returns a new sequence without modifying the original. + +The +.code rot +function always returns a new sequence. In cases when no rotation +is performed, it copies +.meta sequence +as if using the +.code copy +function. +In cases when no rotation is performed, the +.code nrot +function returns the original sequence, which is unmodified. + +The +.meta displacement +parameter, an integer, has a default value of 1. + +To rotate elements means to displace their position within the +.meta sequence +by some amount, that being given by the +.meta displacement +parameter, while partially preserving their circular order. +Circular order means that for the purposes of rotation, the sequence +is regarded to be cyclic: the first element of the sequence is +considered to be the successor of the last element and vice versa. +Thus, when an element is displaced past the first or last position, it wraps to +the end or beginning of the sequence. + +If the sequence is empty, or contains only one element, then +.code rot +and +.code nrot +terminate, performing no rotation. The following remarks apply to situations when +.meta sequence +has two or more elements. + +The +.meta displacement +parameter, which may be negative, is first reduced to the smallest positive +residue modulo the length of the sequence, resulting in a value ranging from +zero to one less than the sequence length. If the resulting value is zero, +then no rotation is performed. + +The +.meta displacement +has a negative orientation: each element's position is decreased by this +amount. Those elements whose position would become negative move to the end of +the sequence. + +The default displacement of 1 causes the first element to become last, +the second element to become first, and so forth. The opposite rotation can be +obtained using -1 as the displacement. + +Note: even though +.code nrot +operates destructively, the returned object may not be the same object as +.metn sequence . +Only the returned object is required to be the rotated sequence. If this +is different from the original +.meta sequence +input, the contents of that original object are unspecified. + +Note: the symbol +.code rotate +is the name of a place-mutating macro, which is much older than these functions. +If +.code S +is a three-element sequence, then: + +.verb + (set S (nrot S)) ;; alternatively: (upd S nrot) +.brev + +has the same effect as: + +.verb + (rotate [S 0] [S 1] [S 2]) +.brev + +.TP* Examples: + +.verb + (rot "abc") -> "bca" + (rot #(1 2 3) -1) -> (3 1 2) + + ;; lower-case rot-13 + (mapcar (relate (range #\ea #\ez) + (rot (range #\ea #\ez) 13)) + "hello, world!") + -> "uryyb, jbeyq!" +.brev + .coNP Function @ sort-group .synb .mets (sort-group < sequence >> [ keyfun <> [ lessfun ]]) |