In this problem, I have three (identically-structured) lists. Two have all numbers and the other is filled with nil. I'm trying to replace the corresponding value in the empty list with the addition of the corresponding values from the two lists. What I have so far utilizes a loop and uses setf to replace the value.
(defun add-two-lists (list1 list2 list3)
(loop for a in list1
for b in list2
for c in list3 do
(setf c (+ a b))))
The problem is that this function is not being destructive. How do I make this function destructive?
Ok, I am aware I could use an apply to do this, but for future or tangent purposes, is there a way to use a loop to do the same thing?
I've decided to resort to my penultimate solution; use the list-length to transverse the lists.
(defun add-two-lists (list1 list2 list3)
(loop for x from 0 to (- (list-length list1) 1) do
(setf (nth x list3) (+ (nth x list1) (nth x list2))))
(values list3))
Here's one way:
(defun add-two-lists (list1 list2 list3)
(loop for a in list1
for b in list2
for c on list3 do
(rplaca c (+ a b)))
ADDENDUM
Here's another way that uses map instead of loop:
(defun add-two-lists (list1 list2 list3)
(mapl #'(lambda (cl al bl) (rplaca cl (+ (car al) (car bl))))
list3 list1 list2))
Yet another way to do the same thing without using a loop (though it's conceptually similar)
(defun add-two-lists (a b c &optional (d c))
(if a
(add-two-lists
(cdr a) (cdr b)
(cdr (rplaca c (+ (car a) (car b)))) d) d))
(add-two-lists '(1 2 3 4 5) '(1 2 3 4 5) '(nil nil nil nil nil))
EDIT
(defun add-two-lists (a b c &optional (d c))
(if a
(add-two-lists
(cdr a) (cdr b)
(cdr (rplaca c (+ (car a) (car b)))) d) d))
(time
(dotimes (i 1e6)
(add-two-lists '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.077 seconds of real time
;; 0.076004 seconds of total run time (0.076004 user, 0.000000 system)
;; 98.70% CPU
;; 214,723,476 processor cycles
;; 0 bytes consed
(defun add-two-lists-1 (list1 list2 list3)
(loop for a in list1
for b in list2
for c on list3 do
(rplaca c (+ a b))))
(time
(dotimes (i 1e6)
(add-two-lists-1 '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.060 seconds of real time
;; 0.060004 seconds of total run time (0.060004 user, 0.000000 system)
;; 100.00% CPU
;; 169,395,444 processor cycles
;; 0 bytes consed
EDIT 2
But notice the optimized version behavior. Possibly, again, YMMV, but this is what I get on 64-bit Debian with SBCL.
(defun add-two-lists (a b c &optional (d c))
(declare (optimize (speed 3) (safety 0)))
(declare (type list a b c d))
(if a
(add-two-lists
(cdr a) (cdr b)
(cdr (rplaca
c
(the fixnum
(+ (the fixnum (car a))
(the fixnum (car b)))))) d) d))
(time
(dotimes (i 1e6)
(add-two-lists '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.041 seconds of real time
;; 0.040002 seconds of total run time (0.040002 user, 0.000000 system)
;; 97.56% CPU
;; 114,176,175 processor cycles
;; 0 bytes consed
(defun add-two-lists-1 (list1 list2 list3)
(declare (optimize (speed 3) (safety 0)))
(loop for a fixnum in list1
for b fixnum in list2
for c cons on list3 do
(rplaca c (the fixnum (+ a b)))))
(time
(dotimes (i 1e6)
(add-two-lists-1 '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.040 seconds of real time
;; 0.040003 seconds of total run time (0.040003 user, 0.000000 system)
;; 100.00% CPU
;; 112,032,123 processor cycles
;; 0 bytes consed
Common Lisp provides a function for that: MAP-INTO.
Related
I am writing an iterative version of the Pell numbers and I need to print out the output of the numbers in a list. I have done everything right up until the list. Instead of returning a flat list, it returns individual lists of the Pell numbers.
I tried to append all the individual lists but it does not work. What am I missing?
(defun iterPell (n)
(let ((a 0) (b 1) (c n))
(loop for i from 2 to n do
(setq c (+ a (* 2 b))
a b
b c))
c))
(dotimes (n 7)
(write(append(list(iterPell n))))
)
>>(0)(1)(2)(5)(12)(29)(70)
(loop for n from 0 to 7
collect (iterPell n))
;; => (0 1 2 5 12 29 70 169)
(let ((res)) ;; initialize collector = ((res nil))
(dotimes (n 7)
(setf res (cons (iterPell n) res))) ;; setf the result new-value-consed
(nreverse res)) ;; revert it (after all consing to beginning of list)
;; => (0 1 2 5 12 29 70 169)
;; or write recursive function
(defun apply-on-0-to-n (n func acc)
(cond ((zerop n) (cons (funcall func 0) acc))
(t (apply-on-0-to-n (1- n) func (cons (funcall func n) acc)))))
(apply-on-0-to-n 7 #'iterPell '())
;; => (0 1 2 5 12 29 70 169)
I was trying to make a recursive function to split a list into two lists according the number of elements one wants.
Ex:
(split 3 '(1 3 5 7 9)) ((1 3 5) (7 9))
(split 7 '(1 3 5 7 9)) ((1 3 5 7 9) NIL)
(split 0 '(1 3 5 7 9)) (NIL (1 3 5 7 9))
My code is like this:
(defun split (e L)
(cond ((eql e 0) '(() L))
((> e 0) (cons (car L) (car (split (- e 1) (cdr L))))))))
I don't find a way to join the first list elements and return the second list.
Tail recursive solution
(defun split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((>= 0 n) (list (reverse acc-l) l))
(t (split (1- n) (cdr l) (cons (car l) acc-l)))))
Improved version
(in this version, it is ensured that acc-l is at the beginning '()):
(defun split (n l)
(labels ((inner-split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((= 0 n) (list (reverse acc-l) l))
(t (inner-split (1- n) (cdr l) (cons (car l) acc-l))))))
(inner-split n l)))
Test it:
(split 3 '(1 2 3 4 5 6 7))
;; returns: ((1 2 3) (4 5 6 7))
(split 0 '(1 2 3 4 5 6 7))
;; returns: (NIL (1 2 3 4 5 6 7))
(split 7 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split 9 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split -3 '(1 2 3 4 5 6 7))
;; returns (NIL (1 2 3 4 5 6 7))
In the improved version, the recursive function is placed one level deeper (kind of encapsulation) by using labels (kind of let which allows definition of local functions but in a way that they are allowed to call themselves - so it allows recursive local functions).
How I came to the solution:
Somehow it is clear, that the first list in the result must result from consing one element after another from the beginning of l in successive order. However, consing adds an element to an existing list at its beginning and not its end.
So, successively consing the car of the list will lead to a reversed order.
Thus, it is clear that in the last step, when the first list is returned, it hast to be reversed. The second list is simply (cdr l) of the last step so can be added to the result in the last step, when the result is returned.
So I thought, it is good to accumulate the first list into (acc-l) - the accumulator is mostly the last element in the argument list of tail-recursive functions, the components of the first list. I called it acc-l - accumulator-list.
When writing a recursive function, one begins the cond part with the trivial cases. If the inputs are a number and a list, the most trivial cases - and the last steps of the recursion, are the cases, when
the list is empty (equal l '()) ---> (null l)
and the number is zero ----> (= n 0) - actually (zerop n). But later I changed it to (>= n 0) to catch also the cases that a negative number is given as input.
(Thus very often recursive cond parts have null or zerop in their conditions.)
When the list l is empty, then the two lists have to be returned - while the second list is an empty list and the first list is - unintuitively - the reversed acc-l.
You have to build them with (list ) since the list arguments get evaluated shortly before return (in contrast to quote = '(...) where the result cannot be evaluated to sth in the last step.)
When n is zero (and later: when n is negative) then nothing is to do than to return l as the second list and what have been accumulated for the first list until now - but in reverse order.
In all other cases (t ...), the car of the list l is consed to the list which was accumulated until now (for the first list): (cons (car l) acc-l) and this I give as the accumulator list (acc-l) to split and the rest of the list as the new list in this call (cdr l) and (1- n). This decrementation in the recursive call is very typical for recursive function definitions.
By that, we have covered all possibilities for one step in the recursion.
And that makes recursion so powerful: conquer all possibilities in ONE step - and then you have defined how to handle nearly infinitely many cases.
Non-tail-recursive solution
(inspired by Dan Robertson's solution - Thank you Dan! Especially his solution with destructuring-bind I liked.)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (destructuring-bind (left right) (split (1- n) (cdr l))
(list (cons (car l) left) right)))))
And a solution with only very elementary functions (only null, list, >=, let, t, cons, car, cdr, cadr)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (let ((res (split (1- n) (cdr l))))
(let ((left-list (car res))
(right-list (cadr res)))
(list (cons (car l) left-list) right-list))))))
Remember: split returns a list of two lists.
(defun split (e L)
(cond ((eql e 0)
'(() L)) ; you want to call the function LIST
; so that the value of L is in the list,
; and not the symbol L itself
((> e 0)
; now you want to return a list of two lists.
; thus it probably is a good idea to call the function LIST
; the first sublist is made of the first element of L
; and the first sublist of the result of SPLIT
; the second sublist is made of the second sublist
; of the result of SPLIT
(cons (car L)
(car (split (- e 1)
(cdr L)))))))
Well let’s try to derive the recursion we should be doing.
(split 0 l) = (list () l)
So that’s our base case. Now we know
(split 1 (cons a b)) = (list (list a) b)
But we think a bit and we’re building up the first argument on the left and the way to build up lists that way is with CONS so we write down
(split 1 (cons a b)) = (list (cons a ()) b)
And then we think a bit and we think about what (split 0 l) is and we can write down for n>=1:
(split n+1 (cons a b)) = (list (cons a l1) l2) where (split n b) = (list l1 l2)
So let’s write that down in Lisp:
(defun split (n list)
(ecase (signum n)
(0 (list nil list))
(1 (if (cdr list)
(destructuring-bind (left right) (split (1- n) (cdr list))
(list (cons (car list) left) right))
(list nil nil)))))
The most idiomatic solution would be something like:
(defun split (n list)
(etypecase n
((eql 0) (list nil list))
(unsigned-integer
(loop repeat n for (x . r) on list
collect x into left
finally (return (list left r))))))
When written this way the error says: 4 parts after if:
(define (rolling-window l size)
(if (< (length l) size) l
(take l size) (rolling-window (cdr l) size)))
and when there's another paranthesis to make it 3 parts:
(define (rolling-window l size)
(if (< (length l) size) l
((take l size) (rolling-window (cdr l) size))))
then it says: application: not a procedure;
How to write more than one expression in if's else in racket/scheme?
Well that's not really the question. The question is "How to build a rolling window procedure using racket?". Anyway, it looks like you're probably coming from another programming language. Processing linked lists can be a little tricky at first. But remember, to compute the length of a list, you have to iterate through the entire list. So using length is a bit of an anti-pattern here.
Instead, I would recommend you create an auxiliary procedure inside your rolling-window procedure which builds up the window as you iterate thru the list. This way you don't have to waste iterations counting elements of a list.
Then if your aux procedure ever returns and empty window, you know you're done computing the windows for the given input list.
(define (rolling-window n xs)
(define (aux n xs)
(let aux-loop ([n n] [xs xs] [k identity])
(cond [(= n 0) (k empty)] ;; done building sublist, return sublist
[(empty? xs) empty] ;; reached end of xs before n = 0, return empty window
[else (aux-loop (sub1 n) (cdr xs) (λ (rest) (k (cons (car xs) rest))))]))) ;; continue building sublist
(let loop ([xs xs] [window (aux n xs)] [k identity])
(cond ([empty? window] (k empty)) ;; empty window, done
([empty? xs] (k empty)) ;; empty input list, done
(else (loop (cdr xs) (aux n (cdr xs)) (λ (rest) (k (cons window rest)))))))) ;; continue building sublists
(rolling-window 3 '(1 2 3 4 5 6))
;; => '((1 2 3) (2 3 4) (3 4 5) (4 5 6))
It works for empty windows
(rolling-window 0 '(1 2 3 4 5 6))
;; => '()
And empty lists too
(rolling-window 3 '())
;; => '()
Here is an alternative:
#lang racket
(define (rolling-window n xs)
(define v (list->vector xs))
(define m (vector-length v))
(for/list ([i (max 0 (- m n -1))])
(vector->list (vector-copy v i (+ i n)))))
(rolling-window 3 '(a b c d e f g))
(rolling-window 3 '())
(rolling-window 0 '(a b c))
Output:
'((a b c) (b c d) (c d e) (d e f) (e f g))
'()
'(() () () ()) ; lack of spec makes this ok !
Following modification of OP's function works. It includes an outlist for which the initial default is empty list. Sublists are added to this outlist till (length l) is less than size.
(define (rolling-window l size (ol '()))
(if (< (length l) size) (reverse ol)
(rolling-window (cdr l) size (cons (take l size) ol))))
Testing:
(rolling-window '(1 2 3 4 5 6) 2)
(rolling-window '(1 2 3 4 5 6) 3)
(rolling-window '(1 2 3 4 5 6) 4)
Output:
'((1 2) (2 3) (3 4) (4 5) (5 6))
'((1 2 3) (2 3 4) (3 4 5) (4 5 6))
'((1 2 3 4) (2 3 4 5) (3 4 5 6))
Any improvements on this one?
(define (rolling-window l size)
(cond ((eq? l '()) '())
((< (length l) size) '())
((cons (take l size) (rolling-window (cdr l) size)))))
I got an unexpected result while solving Problem 75 in Project Euler. My code does find the correct solution, but it behaves strangely.
My solution consists of traversing a Pythagorean tree (Barning's matrices) until the perimeter limit is reached, counting the numbers of times the perimeter assumed each value, and, lastly, counting the perimeter lengths that occurred only once. My admittedly untidy but functioning code is:
(defparameter *barning-matrixes*
'(#(1 -2 2) #(2 -1 2) #(2 -2 3)
#(1 2 2) #(2 1 2) #(2 2 3)
#(-1 2 2) #(-2 1 2) #(-2 2 3)))
(defparameter *lengths* (make-array 1500001 :initial-element 0))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x)
(reduce #'+ (map 'vector #'* n x))) *barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
(expand-node #(3 4 5)) ; Takes too darn long :-(
(count 1 *lengths*)
I expected the tree expansion to run in a few milliseconds, but the expand-node function took 8.65 seconds--a lot more than expected--to traverse a not very large tree.
However, I was surprised when I tweaked the code to remove the vectors...
(defparameter *barning-matrixes*
'((1 -2 2) (2 -1 2) (2 -2 3)
(1 2 2) (2 1 2) (2 2 3)
(-1 2 2) (-2 1 2) (-2 2 3)))
(defparameter *lengths* (make-array 1500001 :initial-element 0))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a list and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x) (reduce #'+ (mapcar #'* n x))) *barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
(expand-node '(3 4 5)) ; Much faster, but why?!
(count 1 *lengths*)
...and the traversing went hugely faster, taking only 35 ms. I'm intrigued by this massive difference and am hoping someone out there can explain why it happened.
Thanks,
Paulo
PS: I'm using CCL for all this.
You didn't say which implementation you were using.
You would need to find out, where the time is spend.
But for me it looks like the implementation of MAP of a list and a vector of equal length to a new vector in your Common Lisp might be very inefficient.
Even when consing a new vector, which has some overhead, the implementation can be much faster.
Try to implement the vector operation as a LOOP and compare:
(loop with v = (make-array (length n))
for n1 across n
for x1 across x
for i from 0
do (setf (aref v i) (* n1 x1))
finally (return v))
This faster version conses too, but has replaced the list operations with vector operations:
(defparameter *barning-matrixes*
#(#(1 -2 2) #(2 -1 2) #(2 -2 3) #(1 2 2) #(2 1 2) #(2 2 3) #(-1 2 2) #(-2 1 2) #(-2 2 3)))
(defparameter *lengths* (make-array 1500001 :initial-element 0))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes
(loop with v = (make-array (length *barning-matrixes*))
for e across *barning-matrixes*
for i from 0
do (setf (aref v i)
(reduce #'+
(loop with v = (make-array (length n))
for n1 across n
for x1 across e
for i from 0
do (setf (aref v i) (* n1 x1))
finally (return v))))
finally (return v))))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
(time (expand-node #(3 4 5)))
Let's look at your code:
(defun expand-node (n)
; here we don't know of which type N is. You call it from the toplevel
; with a vector, but recursive calls call it with a list
"Takes a primitive Pythagorean triple in a vector and traverses
subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x) ; this mapcar creates a list
(reduce #'+
(map 'vector
#'*
n ; <- list or vector
x))) ; <- vector
*barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3)) ; this subseq returns a list most of the times...
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
So you call MAP with a list and a vector most of the times.
What is the size of the result vector? MAP has to find out by traversing the list or by some other way. The result vector length is the shortest of the argument sequence lengths. Then it has to iterate over the list and the vector. If MAP now uses generic sequence operations, the element access into the list is always traversing the list. Obviously one can write an optimized version, which does all that faster, but a Common Lisp implementation might choose to provide only a generic implementation of MAP...
Welcome to the intricacies of Common Lisp optimization!
The first thing to note is about the different program optimization strategies performed by the different implementations: I tried your examples in SBCL, and both of them performed very efficiently with almost the same time, while in CCL the vector version was executed much much slower than the list version. I do not know which implementation you have tried, but you can try to use different implementations to see very different execution times.
From a few tests in CCL it seems to me that the main problem arises from this form:
(map 'vector #'* n x)
which is executed much much slowly than the corresponding list version:
(mapcar #'* n x)
Using time I have seen that the vector version conses a lot.
This first impression has been confirmed by simply changing map with map-into, using an auxiliary vector. Actually the following version is slightly faster in CCL than the list version:
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n))
(temp-vector (make-array 3 :initial-element 0)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x)
(reduce #'+ (map-into temp-vector #'* n x))) *barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
Inspecting vector #(1 2 3) on SBCL gives:
Dimensions: (3)
Element type: T
Total size: 3
Adjustable: NIL
Fill pointer: NIL
Contents:
0: 1
1: 2
2: 3
You can see that there are a little more data to store than in a list, even though the exact internal representation of vectors varies among implementations. For small vectors that keep being copied like in your example, you are likely to end up allocating more memory than with lists, which is visible in the bytes consed lines below. Allocating memory contributes to the run time. In my tests, note that the difference in time is not as big as in your tests.
;; VECTORS
(time (expand-node #(3 4 5)))
;; Evaluation took:
;; 2.060 seconds of real time
;; 2.062500 seconds of total run time (1.765625 user, 0.296875 system)
;; [ Run times consist of 0.186 seconds GC time, and 1.877 seconds non-GC time. ]
;; 100.10% CPU
;; 4,903,137,055 processor cycles
;; 202,276,032 bytes consed
;; LISTS
(time (expand-node* '(3 4 5)))
;; Evaluation took:
;; 0.610 seconds of real time
;; 0.609375 seconds of total run time (0.609375 user, 0.000000 system)
;; [ Run times consist of 0.016 seconds GC time, and 0.594 seconds non-GC time. ]
;; 99.84% CPU
;; 1,432,603,387 processor cycles
;; 80,902,560 bytes consed
Everyone already answered while I was trying to optimize the code, so I'll just put this version here without bothering to explain too much. It should run pretty fast, at least on SBCL.
(declaim (optimize (speed 3) (safety 0) (debug 0)))
(declaim (type (simple-array (simple-array fixnum 1) 1) *barning-matrixes*))
(defparameter *barning-matrixes*
(map '(simple-array (simple-array fixnum 1) 1)
(lambda (list)
(make-array 3 :element-type 'fixnum
:initial-contents list))
'((1 -2 2) (2 -1 2) (2 -2 3)
(1 2 2) (2 1 2) (2 2 3)
(-1 2 2) (-2 1 2) (-2 2 3))))
(declaim (type (simple-array fixnum 1) *lengths*))
(defparameter *lengths* (make-array 1500001 :element-type 'fixnum
:initial-element 0))
(declaim (ftype (function ((simple-array fixnum 1))) expand-node))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(loop with list-of-ns = (list n)
for n = (pop list-of-ns)
while n
do (let ((perimeter (let ((result 0))
(declare (type fixnum result))
(dotimes (i (length n) result)
(incf result (aref n i))))))
(declare (type fixnum perimeter))
(unless (> perimeter 1500000)
(let ((next-nodes
(let ((result (list)))
(dotimes (matrix 9 (nreverse result))
(let ((matrix (aref *barning-matrixes* matrix)))
(push (let ((result 0))
(declare (type fixnum result))
(dotimes (i 3 result)
(incf result
(the fixnum
(* (the fixnum (aref matrix i))
(the fixnum (aref n i)))))))
result))))))
(declare (type list next-nodes))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(dotimes (i 3)
(push (make-array 3 :element-type 'fixnum
:initial-contents (list (pop next-nodes)
(pop next-nodes)
(pop next-nodes)))
list-of-ns))))))
(values))
On my slow laptop,
CL-USER> (load (compile-file #P"e75.lisp"))
; ...compilation notes...
CL-USER> (time (expand-node (make-array 3 :element-type 'fixnum
:initial-contents '(3 4 5))))
Evaluation took:
0.274 seconds of real time
0.264000 seconds of total run time (0.264000 user, 0.000000 system)
96.35% CPU
382,768,596 processor cycles
35,413,600 bytes consed
; No values
CL-USER> (count 1 *lengths*)
161667 (18 bits, #x27783)
The original code ran at around ~1.8 seconds with vectors, and 0.8 seconds with lists.
I was doing a problem from the HTDP book where you have to create a function that finds all the permutations for the list. The book gives the main function, and the question asks for you to create the helper function that would insert an element everywhere in the list. The helper function, called insert_everywhere, is only given 2 parameters.
No matter how hard I try, I can't seem to create this function using only two parameters.
This is my code:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
My desired output for (insert_everywhere 'a (list 1 2 3)) is (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a), but instead my list keeps terminating.
I've been able to create this function using a 3rd parameter "position" where I do recursion on that parameter, but that botches my main function. Is there anyway to create this helper function with only two parameters? Thanks!
Have you tried:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
The insert function allows you to insert values anywhere within a list:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
The range function allows you to create Haskell-style list ranges:
(range 0 3) => (0 1 2 3)
The insert-everywhere function makes use of insert and range. It's pretty easy to understand how it works. If your implementation of scheme doesn't have the fold-right function (e.g. mzscheme) then you can define it as follows:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
As the name implies the fold-right function folds a list from the right.
You can do this by simply having 2 lists (head and tail) and sliding elements from one to the other:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
In Racket, you could also express it in a quite concise way as follows:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
This has a lot in common with my answer to Insert-everywhere procedure. There's a procedure that seems a bit odd until you need it, and then it's incredibly useful, called revappend. (append '(a b ...) '(x y ...)) returns a list (a b ... x y ...), with the elements of (a b ...). Since it's so easy to collect lists in reverse order while traversing a list recursively, it's useful sometimes to have revappend, which reverses the first argument, so that (revappend '(a b ... m n) '(x y ...)) returns (n m ... b a x y ...). revappend is easy to implement efficiently:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
Now, a direct version of this insert-everywhere is straightforward. This version isn't tail recursive, but it's pretty simple, and doesn't do any unnecessary list copying. The idea is that we walk down the lst to end up with the following rhead and tail:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
If you put the recursive call in the place of the ..., then you get the result that you want:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
Now, this isn't tail recursive. If you want a tail recursive (and thus iterative) version, you'll have to construct your result in a slightly backwards way, and then reverse everything at the end. You can do this, but it does mean one extra copy of the list (unless you destructively reverse it).
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
How about creating a helper function to the helper function?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
We need our sublists kept separate, so that each one can be prefixed separately. If we'd append all prematurely, we'd lose the boundaries. So we append only once, in the very end:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
Testing:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
By the way this internal function is tail recursive modulo cons, more or less, as also seen in the illustration. This suggests it should be possible to convert it into an iterative form. Joshua Taylor shows another way, using revappend. Reversing the list upfront simplifies the flow in his solution (which now corresponds to building directly the result row in the illustration, from right to left, instead of "by columns" in my version):
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))