I'm looking for an elegant way to rotate part of a circular vector - for
example:
if *v* = #(0 1 2 3 4 5 6 7 8 9)
(rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
(rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
It's the second case that gets messy - either with a lot of ifs or by
defining circular accessors and then shifting the elements one by one.
Anything neat out there?
martin
>>>>> "Martin" == Martin DeMello <·············@yahoo.com> writes:
Martin> I'm looking for an elegant way to rotate part of a circular vector - for
Martin> example:
Martin> if *v* = #(0 1 2 3 4 5 6 7 8 9)
Martin> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
Martin> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
Martin> It's the second case that gets messy - either with a lot of ifs or by
Martin> defining circular accessors and then shifting the elements one by one.
Martin> Anything neat out there?
Make two copies of *v*, change 7 2 to 7 12, and apply it to your new
array, and extract out just the 10 elements you want?
Ray
Martin DeMello <·············@yahoo.com> writes:
> I'm looking for an elegant way to rotate part of a circular vector - for
> example:
>
> if *v* = #(0 1 2 3 4 5 6 7 8 9)
>
> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
>
> It's the second case that gets messy - either with a lot of ifs or by
> defining circular accessors and then shifting the elements one by one.
> Anything neat out there?
not really properly tested, but wouldn't something like this do what you want?
(defun rotate-left (v a b)
(loop with x = (aref v a)
with n = (length v)
for i from a below (if (< a b) b (+ n b))
do (setf (aref v (mod i n)) (aref v (mod (+ i 1) n)))
finally (setf (aref v b) x))
v)
'as
On 2006-01-27, Martin DeMello <·············@yahoo.com> wrote:
> I'm looking for an elegant way to rotate part of a circular vector - for
> example:
>
> if *v* = #(0 1 2 3 4 5 6 7 8 9)
>
> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
>
> It's the second case that gets messy - either with a lot of ifs or
> by defining circular accessors and then shifting the elements one by
> one. Anything neat out there?
See REPLACE.
; untested
(defun rotate-left (v start end)
(if (< start end)
(let ((temp (aref v start)))
(replace v v :start1 start :end1 (1- end) :start2 (1+ start) :end2 end)
(setf (aref v end) temp))
(let ((last-index (1- (length v)))
(temp0 (aref v 0))
(temp1 (aref v start)))
(replace v v
:start1 start :end1 (1- last-index)
:start2 (1+ start) :end2 last-index)
(setf (aref v last-index) temp0)
(replace v v
:start1 0 :end1 (1- end)
:start2 1 :end2 end)
(setf (aref v end) temp1))))
HTH.
-- Larry
Martin DeMello wrote:
> I'm looking for an elegant way to rotate part of a circular vector - for
> example:
>
> if *v* = #(0 1 2 3 4 5 6 7 8 9)
>
> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
>
> It's the second case that gets messy - either with a lot of ifs or by
> defining circular accessors and then shifting the elements one by one.
> Anything neat out there?
How is it a lot of ifs? There are two cases:
1. start <= end
2. start > end
In the second case, the rotated region is split into two: the head and
the tail.
In the first case, you have to use one temporary location to save the
leftmost value. Then move the elements, and finish by placing the saved
value into the rightmost position.
In the reversed case, you save two elements: the first element of the
vector, and the leftmost element of the tail region. Within the head
and the tail, you do a data move---if the given region is more than one
element long, of course. Then you take the the saved value that was
originally in position 0 of the vector, and put it at the end of the
array, and you take the other saved value, and put it at the rightmost
element of the head region.
You have made things simple for yourself by specifying the rotation in
terms of a first and last value. This representation doesn't allow for
a zero-length subsequence to be expressed, nor for a subsequence of
fewer than two elements in the reversed case! If you specify n -1 and
0, that still rotates two elements: the first and last vector of the
array are swapped. (Replacing the saved values into the array reduces
to doing this swap, since the data moves do nothing, being requested
for zero-length subsequences).
In C, I would do this with two memmoves() and a few assignments. :) The
memmove function handles overlapping memory in an optimized way.
Actually, it occurs to me that you could just use recursion. In the
second case, simply call the rotate-left function on the head region
and on the tail region. Then do a fix-up by swapping two elements.
In other words,
(rotate-left *v* 7 2)
can be done as
(swap-elements (rotate-left (rotate-left *v* 7 9) 0 2) 2 9)
Rotate 7 9, rotate 0 2, swap 2 9. Elegant enough?
Martin DeMello <·············@yahoo.com> writes:
> I'm looking for an elegant way to rotate part of a circular vector - for
> example:
>
> if *v* = #(0 1 2 3 4 5 6 7 8 9)
>
> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
Note that in the standard, the starting index that designate a desired
subrange of a sequence is treated inclusively while the ending index
exclusively. Consequently, my function ROTATE-SUBSEQUENCE, which you'll
find below, will behave as follows:
(equalp (rotate-left *v* 2 5) (rotate-subsequence *v* :start 2 :end 6))
(equalp (rotate-left *v* 7 2) (rotate-subsequence *v* :start 7 :end 3))
> It's the second case that gets messy - either with a lot of ifs or by
> defining circular accessors and then shifting the elements one by one.
> Anything neat out there?
Mine's just as neat as stratified design tends to be. :-) (It contains
an elegant use of circular lists, though, if I may remark.)
-- tcr
;; Copyright (c) 2006 Tobias C. Rittweiler (tcr AT freebits DOT de)
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.
(defmacro with-assertions ((&rest assertions) &body body)
`(progn ,@(mapcar #'(lambda (assertion) `(assert ,assertion)) assertions)
,@body))
(defun make-circular-list (list)
"Returns a copy of LIST that is circular."
(let ((result-list (copy-list list)))
(nconc result-list result-list)))
(defun rotate (seq indices)
"
Similiar to ROTATEF except that this one is a function, not a
modifier-macro and as such doesn't work on places and doesn't
modify anything but returns a new sequence with the elements
of SEQ rotated as by a circular left shift determined by INDICES.
(ROTATE '(0 1 2 3 4 5) '(0 1)) ==> (1 0 2 3 4 5)
(ROTATE '(0 1 2 3 4 5) '(0 1 2) ==> (1 2 0 3 4 5)
The effect of ROTATE can be roughly thought of as follows:
(ROTATE SEQ '(I1 I2 ... In))
~= (LET ((RES (COPY-SEQ SEQ)))
(ROTATEF (ELT RES I1)
(ELT RES I2)
...
(ELT RES In))
RES)
"
;; Notice that all the places that ROTATEF is meant to rotate
;; through are references into the respective data structure as of
;; _before_ any modification took place, i.e.
;; (ROTATEF place1 place2 place3)
;; is _not_ equivalent to
;; (PROGN (ROTATEF place1 place2)
;; (ROTATEF place2 place3)
;; (ROTATEF place3 place1))
;; (Consequently, the same has to be valid for the function here.)
(let ((result-seq (copy-seq seq)))
(loop
for nil in indices ; termination criterium
for (cur-idx next-idx) on (make-circular-list indices)
do (setf (elt result-seq cur-idx) (elt seq next-idx)))
result-seq))
(defun sublength (seq &key (start 0) (%length (length seq)) (end %length) circularly)
"
Returns the length of SEQ between START and END.
(SUBLENGTH '(0 1 2 3 4 5) :START 2 :END 4) ==> 2
This is mostly interesting when CIRCULARLY is given, since it's
then allowed that START is greater than END, meaning that the
length is computed as if SEQ were circular.
(SUBLENGTH '(0 1 2 3 4 5) :START 4 :END 2 :CIRCULARLY T) ==> 4
;;; (that's the elements 4, 5, 0 and 1.)
"
(if (not circularly)
(with-assertions ((>= %length end start 0))
(- end start))
(with-assertions ((>= %length end 0) (>= %length start 0))
(if (<= start end)
(- end start)
(+ (- %length start) end)))))
(defun rotate-sequence (seq &key (start 0) (%length (length seq)) (end %length))
"
Returns a new sequence where the subsequence of SEQ reaching
from START to END is circularly rotated by one element.
(ROTATE-SEQUENCE '(0 1 2 3 4 5)) ==> (1 2 3 4 5 0)
(ROTATE-SEQUENCE #(0 1 2 3 4 5) :start 3 :end 5) ==> #(0 1 2 4 3 5)
If START is greater than END, the sequence SEQ is treated as if
being circular:
(ROTATE-SEQUENCE #(0 1 2 3 4 5) :start 5 :end 3) ==> #(1 2 5 3 4 0)
;;; Note how the elements 3 and 4 (that lay between position
;;; 3 and 5) were ignored by the rotation.
"
(rotate seq (iota (sublength seq :start start :end end
:circularly t :%length %length)
:start start :modulo %length)))
(defun %iota (count &optional (start 0) (step 1))
(loop repeat count for i from start by step collect i))
(defun iota (count &key (start 0) (step 1) modulo)
"
Returns a list of COUNT numbers beginning with START that are
then sequentially increased by STEP.
(IOTA 10) ==> (0 1 2 3 4 5 6 7 8 9)
(IOTA 10 :START 4 :STEP 2) ==> (4 6 8 10 12 14 16 18 20 22)
If MODULO is given, then a modulus of MODULO is performed on
each number:
(IOTA 10 :START 4 :STEP 2 :MODULO 18) ==> (4 6 8 10 12 14 16 0 2 4)
"
(if (not modulo)
(%iota count start step)
(loop
repeat count
for i = start then (mod (+ i step) modulo)
collect i)))
Tobias C. Rittweiler wrote:
> Martin DeMello <·············@yahoo.com> writes:
>
> > I'm looking for an elegant way to rotate part of a circular vector - for
> > example:
> >
> > if *v* = #(0 1 2 3 4 5 6 7 8 9)
> >
> > (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> > (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
>
> Note that in the standard, the starting index that designate a desired
> subrange of a sequence is treated inclusively while the ending index
> exclusively.
With this representation, what you can do is allow (0 0), (1 1) ...
((1- N) (1-N)) all to represent the entire vector. As a special case,
you can allow N to serve as zero for the end boundary. This can be
exploited internally. Whenever the end index is passed in as 0, the
function can translate it to N (one element beyond the end).
This eliminates the cases where a non-wrapping rotation is expressed by
flipped indices.
;;; Internal, handles (< start end) only
;;; (= end (length vec)) is permitted
(defun rotate-left-simple (vec start end)
;;; exercise for reader
)
(defun rotate-left (vec start end)
(cond
((< start end) (rotate-left-simple vec start end))
((= start end) (rotate-left-simple vec 0 (length vec))
((zerop end) (rotate-left-simple vec start (length vec))
(t ... split case)))
The split case looks like:
(swap-elements
(rotate-left-simple
(rotate-left-simple
vec start (length vec))
0 end))
(1- end) (1- (length vec)))
The SWAP-ELEMENTS function exchanges the two specified elements of the
vector and returns the vector.
Martin DeMello <·············@yahoo.com> wrote:
> I'm looking for an elegant way to rotate part of a circular vector - for
> example:
>
> if *v* = #(0 1 2 3 4 5 6 7 8 9)
>
> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
Thanks for the answers, everyone - I learnt a lot of useful lisp
techniques. (Kaz's algorithm was my favourite, I think - it had a nicely
mathematical elegance to it.)
martin
Martin DeMello <·············@yahoo.com> writes:
> I'm looking for an elegant way to rotate part of a circular vector - for
> example:
> if *v* = #(0 1 2 3 4 5 6 7 8 9)
> (rotate-left *v* 2 5) -> #(0 1 3 4 5 2 6 7 8 9)
> (rotate-left *v* 7 2) -> #(1 2 7 3 4 5 6 8 9 0)
Why did nobody so far suggest using a hidden array of roughly twice
(or whatever factor) the original size and using ADJUST-ARRAY on a
displaced array?
(defvar *larger-array* (make-array (some-factor) :element-type ...))
(setq *v* (make-array length :displaced-to *larger-array* :element-type ...))
Then, in most cases, rotate-left copies nothing but a single element.
It then adjusts an offset into the background array: a simple operation.
CLHS says about ADJUST-ARRAY:
If adjust-array is applied to an array that is actually adjustable,
the array returned is identical to array.
Thus, the array to be adjusted preserves identity. What do you want more?
Here's how to adjust the offset:
(multiple-value-bind (orig offset) (array-displacement *v*)
;; case when reaching end of array left as exercise to reader
(adjust-array *v* (length *v*) :element-type ...
:displaced-to orig :displaced-index-offset (1+ offset)))
;; not shown: copy single element that fell off left side
If adjust-array is not terribly slow, nothing should beat this method
for large enough arrays...
Regards,
Jorg Hohle
Telekom/T-Systems Technology Center