HC_
HC_

Reputation: 1050

Functional program - write a function to rearrange an array from the middle

The task is to write a function that takes a list such as (7 8 2 9 5 6) and then "unwinds" it from the center, rearranging it to be 2 9 then 2 9 8 5 then finally the end output is 2 9 8 5 7 6

I have figured out ROUGHLY the pseudocode:

So,

7 8 2 9 5 6 ->

7 8 2 9 5 -> 6

8 2 9 5 -> 7 6

8 2 9 -> 5 7 6

2 9 -> 8 5 7 6

2 -> 9 8 5 7 6

-> 2 9 8 5 7 6 Correct final output

Here is where my code is so far (not very far at all)

(define (lastElement L) ;returns the last element of array L
 (if (null? (cdr L)) (car L)
 (lastElement (cdr L))))

(define (unwind U)
 (if (null? U) ( (cons (lastElement L) '() )) ;generates a syntax error
 (U)
  )

At my syntax error comment, what I am trying to do is.. if array U is !null, then prepend lastElement L to a new array... and then somehow from there I have to figure out how to remove lastElement L from U and then get the first element and remove that.. Which would be through car and/or cdr, I believe.

edit-- alternate possible approach?

(define (lastElement L)
 (if (null? (cdr L)) (car L)
 (lastElement (cdr L))))

(define (trim lst)
    (if (null? (cdr lst))
        '()
        (cons (car lst) (trim (cdr lst)))))

(define (first-half lst)
  (take lst (quotient (length lst) 2)))



(define (unwind U)
 (if (= (length U) 1 ) 999
  ( (lastElement (first-half U))
     (car (list-tail U (length(first-half U))))
          (unwind (cons
                   (trim (length (first-half U)))
                   (cdr (list-tail U (length(first-half U))))
                   )
                  )
  )
 )
)



(unwind '(7 8 2 9 5 6))

Upvotes: 3

Views: 204

Answers (4)

Daniel Jour
Daniel Jour

Reputation: 16156

I wanted to add another solution, using what I know from Haskell as zipper.

Basically, a zipper on a list consists of a point, marking the current focus, a list of what's to come left of that point and another list with what is going to come right of the point.

;; Creating our zipper abstraction
(define (make-zipper l p r)
 "Create a zipper with what's to come left of point,
 what's at point and what's right of the point."
 (list l p r))
(define (zipper-point z)
 "Get the point of the zipper."
 (cadr z))
(define (zipper-left z)
 "Get what's left of the zipper, in the order as if
 the point moved to the left."
 (car z))
(define (zipper-right z)
 "Get what's right of the zipper."
 (caddr z))

A list can easily be converted into a zipper with the point at the first element:

;; Conversion into our new data type
(define (zipper-from-list l)
 "Create a zipper from a (non empty) list, and
 place the point at the first element."
 (make-zipper '() (car l) (cdr l)))

Here comes the cool thing with zippers: Moving around. Basically this is like a pointer in languages like C or C++. You can move to the left or right, and you can modify the value currently pointed to (without costly rebuilding and traversing all values, as it would be with a simple list).

;; Movement on zippers.
;; (2 1) 3 (4 5)
;; move-right => (3 2 1) 4 (5)
;; move-left => (1) 2 (3 4 5)
(define (zipper-move-right z)
 "Return a zipper with the point moved one to the
 right."
 (make-zipper
  (cons (zipper-point z) (zipper-left z))
  (car (zipper-right z))
  (cdr (zipper-right z))))
(define (zipper-move-left z)
 "Return a zipper with the point moved one to the
 left."
 (make-zipper
  (cdr (zipper-left z))
  (car (zipper-left z))
  (cons (zipper-point z) (zipper-right z))))

Now comes a special thing that I wanted my zipper to do for this task: Destroying the value at point and filling the resulting gap with a value from either the left or the right:

;; A special kind of moving, destructing the value at point.
;; (2 1) 3 (4 5)
;; zipper-squash-left => (1) 2 (4 5)
;; zipper-squash-right => (2 1) 4 (5)
(define (zipper-squash-right z)
 "Squash the value at point and close the gap
 with a value from right."
 (make-zipper
  (zipper-left z)
  (car (zipper-right z))
  (cdr (zipper-right z))))
(define (zipper-squash-left z)
 "Squash the value at point and close the gap
 with a value from left."
 (make-zipper
  (cdr (zipper-left z))
  (car (zipper-left z))
  (zipper-right z)))

Adding some boring test functions ...

;; Testing for the end points of the zipper.
(define (zipper-left-end? z)
 "Check whether the zipper is at the left end."
 (eq? '() (zipper-left z)))
(define (zipper-right-end? z)
 "Check whether the zipper is at the right end."
 (eq? '() (zipper-right z)))

... we come to the heart of my answer: "Pulling" a list out of a zipper. Just think of the zipper like a mark on a rope. When you pull at that mark, the two parts of the rope will fold together. If there are marks on the rope (i.e. the numbers) you will first see the ones closest to the mark you pulled on.

;; Pull out a list from the current position of the
;; point.
(define (pull-list-from-zipper z)
 "Pull out a list from the current point of the
 zipper. The list will have the point as first value, followed
 by the one right to it, then the one left of it, then another
 one from the right and so on."
 (cond
  ((zipper-left-end? z) (cons (zipper-point z) (zipper-right z)))
  ((zipper-right-end? z) (cons (zipper-point z) (zipper-left z)))
  (else
   (let* ((p1 (zipper-point z))
             (z1 (zipper-squash-right z))
             (p2 (zipper-point z1))
             (z2 (zipper-squash-left z1)))
    (cons p1 (cons p2 (pull-list-from-zipper z2)))))))

Note that there exists a second variant, which would take first the left value and then the right one.

With that, writing your unwind becomes trivial: You convert the list to a zipper, move to the mid value, and pull:

;; What we wanted to to.
(define (unwind l)
 "Move to the mid and pull a list out of the list."
 (let ((steps (quotient (- (length l) 1) 2)))
  (pull-list-from-zipper
   ((repeated zipper-move-right steps) (zipper-from-list l)))))

Performance wise this needs a full traversal of the list, plus moving the zipper half that distance, and of course pulling out a new list will be in O(n). The code above is not optimized for performance (tail recursion ..) but for ease of understanding.

A full example is here.

As final note, the zipper could have been implemented without having a value at point, but with the point being between two values (as it is, for example, done in emacs), but I wanted to stay close to the Haskell version.

Upvotes: 2

uselpa
uselpa

Reputation: 18917

An even easier solution is to create a reversed copy of the list and then alternatively take the first element of each. The stop condition being when the resulting list has the same length as the initial list:

(define (unwind lst)
  (define maxlen (length lst))
  (let loop ((lst1 lst) (lst2 (reverse lst)) (res null) (len 0))
    (if (= len maxlen)
        res
        (if (even? len)
            (loop lst1 (cdr lst2) (cons (car lst2) res) (add1 len))
            (loop (cdr lst1) lst2 (cons (car lst1) res) (add1 len))))))

testing:

> (unwind '(1 1 2 3 5 8 13))
'(3 2 5 1 8 1 13)
> (unwind '(7 8 2 9 5 6))
'(2 9 8 5 7 6)

Upvotes: 1

WorBlux
WorBlux

Reputation: 1413

I took a classic turtle and hare recursion to split the list in half. You walk it with a cdr and cddr (cdr of the cdr) so when the faster recurring half is null or a singleton list the slower half gives you the last half of the list. I also accumulated a reversed front half of the list as it comes in handy later.

   (define (unwind L)
       (let loop ((HalfR '()) (Turtle L) (Hare L))
          (cond ((null? Hare) (interleave HalfR Turtle))
                ((null? (cdr Hare)) 
                 (cons (car Turtle) (interleave HalfR (cdr Turtle))))
                (else (loop (cons (car Turtle) HalfR)
                            (cdr Turtle)
                            (cddr Hare))))))

(define (interleave L1 l2)
  (OR (AND (null? L1) L2)   ;;**to catch cases where L1 and L2 are not equal.
      (AND (null? L2) L1)   ;;after interleaving to the extent possible. 
      (cons (car L1)        
            (cons (car L2) 
                  (interleave (cdr L1) (cdr L2)))))) 

1 ]=> (unwind '(1 1 2 3 5 8 13))
;Value 11: (3 2 5 1 8 1 13)

1 ]=> (unwind '(7 8 2 9 5 6))
;Value 12: (2 9 8 5 7 6)

Upvotes: 2

Óscar López
Óscar López

Reputation: 236004

This is tricky… Here's an approach close to what you described in the question, including correctly handling the edge cases (empty list, list with an odd number of elements):

(define (unwind lst)
  (let loop ((lst lst)
             (acc '())
             (last? #t))
    (cond ((null? lst)
           acc)
          ((null? (cdr lst))
           (if last?
               (append acc lst)
               (cons (car lst) acc)))
          (last?
           (loop (drop-right lst 1)
                 (cons (last lst) acc)
                 #f))
          (else
           (loop (cdr lst)
                 (cons (car lst) acc)
                 #t)))))

Note that I'm using a couple of built-in functions to make things easier, in particular the append, last and drop-right procedures. The key insight was to pass a boolean flag indicating at each step if we should take the first or the last element of the list, this is used even for the case when there's only one element left. It works as expected:

(unwind '())
=> '()

(unwind '(7 6))
=> '(7 6)

(unwind '(7 8 2 9 5 6))
=> '(2 9 8 5 7 6)

(unwind '(7 8 2 0 9 5 6))
=> '(2 9 8 5 7 6 0)

Upvotes: 1

Related Questions