((1 2 3)
(2 3 4)
(3 4 5)
(4 5 6))
from
(1 2 3 4 5 6)
And what is the type of such operation?
What I tried:
(loop
:with l2 = '()
:with l1 = '(1 2 3 4 5 6)
:for i :in l1
:do (push (subseq l1 0 3) l2))
You're pushing the same sublist every time through the loop.
You can use :for sublist on to loop over successive tails of a list.
And use :collect to make a list of all the results, rather than pushing onto your own list
(loop
:for l1 on '(1 2 3 4 5 6)
:if (>= (length l1) 3)
:collect (subseq l1 0 3)
:else
:do (loop-finish))
Alternatively use map:
(let ((l '(1 2 3 4 5 6)))
(map 'list #'list l (cdr l) (cddr l)))
;; ((1 2 3) (2 3 4) (3 4 5) (4 5 6))
You can read it as:
for list l with values (1 2 3 4 5 6)
map over the list and its two successive cdrs
by applying #'list on the elements of the lists map is looping through in parallel
(stopping when shortest list is used up)
and collecting the results as/into a 'list
#WillNess suggested even simpler:
(let ((l '(1 2 3 4 5 6)))
(mapcar #'list l (cdr l) (cddr l)))
thanks! So then we could generalize using only map variants:
(defun subseqs-of-n (l n)
(apply #'mapcar #'list (subseq (maplist #'identity l) 0 n)))
(maplist #'identity l) is equivalent to (loop for sl on l collect sl).
However,
(loop for sl on l
for i from 0 to n
collect sl)
is better because it stops at n-th round of looping ...
First let's define a function take-n, which either returns n items or an empty list, if there are not enough items. It will not scan the whole list.
(defun take-n (n list)
(loop repeat n
when (null list) return (values nil nil)
collect (pop list)))
Then we move this function take-n over the list until it returns NIL.
(defun moving-slice (n list)
(loop for l on list
for p = (take-n n l)
while p
collect p))
Example:
CL-USER 207 > (moving-slice 3 '(1 2))
NIL
CL-USER 208 > (moving-slice 3 '(1 2 3))
((1 2 3))
CL-USER 209 > (moving-slice 3 '(1 2 3 4 5 6 7))
((1 2 3) (2 3 4) (3 4 5) (4 5 6) (5 6 7))
Here's a version of Barmar's answer (which should be the accepted one) which is a bit more general and only calls length once.
(defun successive-leading-parts (l n)
(loop repeat (1+ (- (length l) n))
for lt on l
collect (subseq lt 0 n)))
> (successive-leading-parts '(1 2 3 4) 3)
((1 2 3) (2 3 4))
> (successive-leading-parts '(1 2 3 4) 2)
((1 2) (2 3) (3 4))
Or the classical more C-like for-loop-ing with indexes to solve it.
But use it more on strings/vectors but less on lists, because its performance is
for lists quadratic
for vectors (strings!) linear, so preferably to be used with them!
credits and thanks to #WillNess who pointed both points out (see comments below).
(defun subseqs-of-n (ls n) ;; works on strings, too!
(loop :for i :from 0 :to (- (length ls) n)
:collect (subseq ls i (+ i n))))
So on vectors/strings use:
(subseqs-of-n "gattaca" 5)
;; ("gatta" "attac" "ttaca")
Related
The function has 1 parameter, an integer.
For example rot-left(2 '(1 2 3 4 5)) should return (3 4 5 1 2 ) and rot-right(2 '(1 2 3 4 5)) should return (5 4 1 2 3).
I've tried this... it doesn't work but what it's supposed to do is add the last n elements of a list to an empty list.
(defun rot_left (n l)
(if (zerop n)
'()
(append (last l)
rot-left ((- n 1) (cdr l)))))
I will give a solution assuming that, if the function rot-right should rotate the elements of the list from right to left, (rot-right 2 '(1 2 3 4 5)) should produce (4 5 1 2 3) and not (5 4 1 2 3).
Then, assuming that this interpretation is correct, the functions can be written only by means of primitive operators in Common Lisp, without the use of iteration or recursion:
(defun rot-left(n l)
(append (nthcdr n l) (butlast l (- (length l) n))))
(defun rot-right(n l)
(rot-left (- (length l) n) l))
(defvar a '(1 2 3 4 5))
(rot-left 2 a) ; produces (3 4 5 1 2)
(rot-right 2 a) ; produces (4 5 1 2 3)
I want to reverse only the continuous sequences, not all the elements of my original list.
Ex:
(reverseC '( 1 2 ( 4 5 ) 5 ) ) => ( 2 1 ( 5 4 ) 5 )
(reverseC '(1 4 2 (3 4) 9 6 (7 8)))) => (2 4 1 (4 3) 6 9 (8 7))
I was thinking of splitting it into 2 functions: one to reverse a simple list ( 1 2 3 ) -> ( 3 2 1 ) and one function
(main) to determine the continuous sequences, make a list out of them, apply reverse on that list and the remake the whole reversed list.
(defun reverse-list ( lista )
(if (eql lista () )
()
(append (reverse-list (cdr lista )) (list ( car lista)))
)
)
This is the reverse function but I have no idea how to do the other one. I'm new to Lisp and I come from Prolog so it's a pretty big change of scenery. Any idea is welcome.
(defun reverse-more (L)
(if (eql L nil)
nil
(let ( el (car L)) (aux (cdr L)))
(if (eql (listp el) nil)
...No idea on the rest of the code ...
There's already an accepted answer, but this seems like a fun challenge. I've tried to abstract some of the details away a bit, and produced a map-contig function that calls a function with each contiguous sublist of the input list, and determines what's a contiguous list via a predicate that's passed in.
(defun map-contig (function predicate list)
"Returns a new list obtained by calling FUNCTION on each sublist of
LIST consisting of monotonically non-decreasing elements, as determined
by PREDICATE. FUNCTION should return a list."
;; Initialize an empty RESULT, loop until LIST is empty (we'll be
;; popping elements off of it), and finally return the reversed RESULT
;; (since we'll build it in reverse order).
(do ((result '())) ((endp list) (nreverse result))
(if (listp (first list))
;; If the first element is a list, then call MAP-CONTIG on it
;; and push the result into RESULTS.
(push (map-contig function predicate (pop list)) result)
;; Otherwise, build up sublist (in reverse order) of contiguous
;; elements. The sublist is finished when either: (i) LIST is
;; empty; (ii) another list is encountered; or (iii) the next
;; element in LIST is non-contiguous. Once the sublist is
;; complete, reverse it (since it's in reverse order), call
;; FUNCTION on it, and add the resulting elements, in reverse
;; order, to RESULTS.
(do ((sub (list (pop list)) (list* (pop list) sub)))
((or (endp list)
(listp (first list))
(not (funcall predicate (first sub) (first list))))
(setf result (nreconc (funcall function (nreverse sub)) result)))))))
Here's your original example:
(map-contig 'reverse '< '(1 2 (4 5) 5))
;=> (2 1 (5 4) 5)
It's worth noting that this will detect discontinuities within a single sublist. For instance, if we only want continuous sequences of integers (e.g., where each successive difference is one), we can do that with a special predicate:
(map-contig 'reverse (lambda (x y) (eql y (1+ x))) '(1 2 3 5 6 8 9 10))
;=> (3 2 1 6 5 10 9 8)
If you only want to break when a sublist occurs, you can just use a predicate that always returns true:
(map-contig 'reverse (constantly t) '(1 2 5 (4 5) 6 8 9 10))
;=> (5 2 1 (5 4) 10 9 8 6)
Here's another example where "contiguous" means "has the same sign", and instead of reversing the contiguous sequences, we sort them:
;; Contiguous elements are those with the same sign (-1, 0, 1),
;; and the function to apply is SORT (with predicate <).
(map-contig (lambda (l) (sort l '<))
(lambda (x y)
(eql (signum x)
(signum y)))
'(-1 -4 -2 5 7 2 (-6 7) -2 -5))
;=> (-4 -2 -1 2 5 7 (-6 7) -5 -2)
A more Prolog-ish approach
(defun reverse-contig (list)
(labels ((reverse-until (list accumulator)
"Returns a list of two elements. The first element is the reversed
portion of the first section of the list. The second element is the
tail of the list after the initial portion of the list. For example:
(reverse-until '(1 2 3 (4 5) 6 7 8))
;=> ((3 2 1) ((4 5) 6 7 8))"
(if (or (endp list) (listp (first list)))
(list accumulator list)
(reverse-until (rest list) (list* (first list) accumulator)))))
(cond
;; If LIST is empty, return the empty list.
((endp list) '())
;; If the first element of LIST is a list, then REVERSE-CONTIG it,
;; REVERSE-CONTIG the rest of LIST, and put them back together.
((listp (first list))
(list* (reverse-contig (first list))
(reverse-contig (rest list))))
;; Otherwise, call REVERSE-UNTIL on LIST to get the reversed
;; initial portion and the tail after it. Combine the initial
;; portion with the REVERSE-CONTIG of the tail.
(t (let* ((parts (reverse-until list '()))
(head (first parts))
(tail (second parts)))
(nconc head (reverse-contig tail)))))))
(reverse-contig '(1 2 3 (4 5) 6 7 8))
;=> (3 2 1 (5 4) 8 7 6)
(reverse-contig '(1 3 (4) 6 7 nil 8 9))
;=> (3 1 (4) 7 6 nil 9 8)
Just two notes about this. First, list* is very much like cons, in that (list* 'a '(b c d)) returns (a b c d). list** can take more arguments though (e.g., **(list* 'a 'b '(c d e)) returns (a b c d e)), and, in my opinion, it makes the intent of lists (as opposed to arbitrary cons-cells) a bit clearer. Second, the other answer explained the use of destructuring-bind; this approach could be a little bit shorter if
(let* ((parts (reverse-until list '()))
(head (first parts))
(tail (second parts)))
were replaced with
(destructuring-bind (head tail) (reverse-until list '())
You can perform all at once with a single recursive function, with the usual warning that you should favor looping constructs over recursive approaches (see below):
(defun reverse-consecutive (list &optional acc)
(etypecase list
;; BASE CASE
;; return accumulated list
(null acc)
;; GENERAL CASE
(cons (destructuring-bind (head . tail) list
(typecase head
(list
;; HEAD is a list:
;;
;; - stop accumulating values
;; - reverse HEAD recursively (LH)
;; - reverse TAIL recursively (LT)
;;
;; Result is `(,#ACC ,LH ,#LT)
;;
(nconc acc
(list (reverse-consecutive head))
(reverse-consecutive tail)))
;; HEAD is not a list
;;
;; - recurse for the result on TAIL with HEAD
;; in front of ACC
;;
(t (reverse-consecutive tail (cons head acc))))))))
Exemples
(reverse-consecutive '(1 2 (3 4) 5 6 (7 8)))
=> (2 1 (4 3) 6 5 (8 7))
(mapcar #'reverse-consecutive
'((1 3 (8 3) 2 )
(1 4 2 (3 4) 9 6 (7 8))
(1 2 (4 5) 5)))
=> ((3 1 (3 8) 2)
(2 4 1 (4 3) 6 9 (8 7))
(2 1 (5 4) 5))
Remarks
#Melye77 The destructuring-bind expression does the same thing as [Head|Tail] = List in Prolog. I could have written this instead
(let ((head (first list))
(tail (rest list)))
...)
Likewise, I prefer to use (e)typecase over the generic cond expression whenever possible, because I think it is more precise.
I could have written:
(if acc
(if (listp (first list))
(nconc ...)
(reverse-consecutive ...))
acc)
... but I think it is less clear and not a good thing to teach beginners.
On the contrary, I think it is useful, even (especially) for beginners, to introduce the full range of available constructs.
For example, overusing recursive functions is actually not recommended: there are plenty of existing iteration constructs for sequences that do not depend on the availability of tail-call optimizations (which are not guaranteed to be implemented, though it is generally available with appropriate declarations).
Iterative version
Here is an iterative version which uses of the standard reverse and nreverse functions. Contrary to the above method, inner lists are simply reversed (contiguous chunks are only detected at the first level of depth):
(defun reverse-consecutive (list)
(let (stack result)
(dolist (e list (nreverse result))
(typecase e
(list
(dolist (s stack)
(push s result))
(push (reverse e) result)
(setf stack nil))
(t (push e stack))))))
I am trying to implement two functions : subterm and replace.
subterm takes two lists as arguments and prints the element in the first list that is reached after exhausting the second list.
For example, calling
(subterm '(1 2 (3 4 5) (6 (7 (8) 9 10))) '(4 2 2 1))
should return
8
I have come up with the following function which prints the nth element in the list :
(define (subterm list n)
(cond
((null? list) '())
((= n 1) (car list))
(else (subterm (cdr list) (- n 1)))))
replace takes 3 lists and returns the result of replacing the reached value with the rest of the list unchanged.
for example calling :
(replace '(1 2 (3 4 5) (6 (7 (8) 9 10))) '(11 12) '(4 2 2 1))
should return :
'(1 2 (3 4 5) (6 (7 ((11 12)) 9 10)))
Again, I came up with this code which replaces the nth element in the first list with the second list, leaving the rest of the first list unchanged :
#lang racket
(define (replace list elem n)
(cond
((empty? list) empty)
((eq? n 1) (cons elem (cdr list)))
(#t (cons (car list) (replace (cdr list) elem (- n 1))))))
How do I modify these functions to take in two lists?
Edit 1:
Some examples:
> (subterm '(1 2 3 4 5) '(3))
3
> (subterm '(1 2 3 4 5) '(2))
2
> (subterm '(1 2 (3 4 5) 6 7) '(3 2))
4
Consider this example:
> (subterm '(1 2 (3 4 5) (6 (7 (8) 9 10))) '(4 2 2 1))
8
In the above example, subterm takes 2 lists. Then it reads the second list. The second list basically tells subterm to return the 1st element (8) of the 2nd element ((8)) of the 2nd element (7 (8) 9 10) of the 4th element (6 (7 (8) 9 10) of the first list (1 2 (3 4 5) (6 (7 (8) 9 10))).
> (subterm '1 '())
1
> (subterm '(1 2 (3 4 5) (6 (7 (8) 9 10))) '())
'(1 2 (3 4 5) (6 (7 (8) 9 10)))
> (replace '(1 2 3 4 5) '(6 7 8) '(3))
'(1 2 (6 7 8) 4 5)
> (replace '(1 2 3 4 5) '(6 7 8) '(2))
'(1 (6 7 8) 3 4 5)
Consider this example:
> (replace '(1 2 (3 4 5) 6 7) '(8 9) '(3 2))
'(1 2 (3 (8 9) 5) 6 7)
replace takes in three lists: first list is the list in which elements have to be replaced. The second list contains the new elements which have to be put into the first list. The third list contains the positions where the elements have to be replaced.
So, it basically replaced the 2nd element (4) of the 3rd element (3 4 5) of the first list (1 2 (3 4 5) 6 7).
> (replace '(1 2 (3 4 5) (6 (7 (8) 9 10))) '(11 12) '(4 2 2 1))
'(1 2 (3 4 5) (6 (7 ((11 12)) 9 10)))
> (replace '(1 2 (3 4 5) (6 (7 (8) 9 10))) 1000 '(4 2 2 1))
'(1 2 (3 4 5) (6 (7 (1000) 9 10)))
> (replace '(1 2 (3 4 5) (6 (7 (8) 9 10))) 'x '())
'x
> (replace '1 '(2 3 4) '())
'(2 3 4)
First of all, you're using the name subterm for two different functions. Let's call the version you provided a code example for list-ref, and make the (car list) case happen when n = 0 instead of 1:
(define (list-ref list n)
(cond
((null? list) '())
((= n 0) (car list))
(else (list-ref (cdr list) (- n 1)))))
As it turns out, list-ref is already in the racket library, so you shouldn't really have to implement it in the first place. So using that, your subterm is trivial:
(define (subterm main-list path)
(match path
('() #f)
((list n) (list-ref main-list (sub1 n)))
((cons n rest) (subterm (list-ref main-list (sub1 n)) rest))))
I tried to code the replace procedure. With my knowledge I can say this is a hard one. However I managed to make it work at least with the example you gave. You could read it, try to understand it and then try to modify it to work with any other list. I believe you'll need an extra function to make it work properly.
#lang racket
(require racket/trace)
(define (replace list elem n)
(cond
((empty? list) empty)
((eq? n 1) (cons elem (cdr list)))
(#t (cons (car list) (replace (cdr list) elem (- n 1))))))
(define replace-with-lists
(λ (items replacement path res aux)
(letrec ([splits (list-split-at items (car path) '())])
(cond
((empty? (cdr path))
; (append
; (car (list-ref res 0))
; (list (append
; (car (list-ref res 1))
; (list (append (car aux)
; (replace (list-ref aux 1) replacement (car path))
; (list-ref aux 2)))))))
(let ([result (replace splits replacement 2)])
(replace aux
(append (car result)
(list (cadr result))
(caddr result)
)
2)))
(else
(replace-with-lists
(list-ref splits 1)
replacement
(cdr path)
(foldr cons (list (list
(list-ref splits 0)
(list-ref splits 2)))
res)
splits
)))
))
)
(define list-split-at
(λ (lst place res)
(cond
((empty? lst) res)
((= 1 place) (foldl cons
(list (cdr lst))
(foldr cons (list res) (list (car lst)))
))
(else
(list-split-at (cdr lst) (- place 1) (foldr cons (list (car lst)) res))
)
)))
(trace replace-with-lists)
Ok, I am in your programming languages class, and I am aware that this assignment is due tomorrow, so I don't want to help too much, or give you the answer. I will do my best to give you some hints in case you are still struggling. The following hints are for the replace function.
First, you need a base case. We are given this with the following
(replace '(1 2 (3 4 5) (6 (7 (8) 9 10))) 'x '())
'x
(replace '1 '(2 3 4) '())
'(2 3 4)
To do this, we just need a conditional statement that checks for an empty list. It is clear that if the last argument is an empty list, we need to "return" the second to last argument. (in your code this would be "elem" and "n")
Now comes the difficult part. It is really quite simply once you realize how many built in functions scheme/racket has. Here are the only ones I used, but they made solving the problem much much easier.
(append)
(list)
(take)
(drop)
(list-ref) //this one is more of a convenience than anything.
After the turn in date has passed, I will post my solution. Hope this helped.
EDIT: As this assignment was due a few minutes, I will post my solution as I don't think that would be considered cheating.
lang racket
(define (subterm term1 lat)
(cond
[(eqv? lat '()) term1]
[(eqv? (car lat)1) (subterm (car term1) (cdr lat))]
[else (subterm (cdr term1) (cons(-(car lat)1)(cdr lat)))])
)
(define (replace term1 term2 lat)
(cond
[(eqv? lat '()) term2]
[else (append(take term1 (-(car lat)1)) (list(replace (list-ref term1 (-(car lat)1)) term2 (cdr lat))) (drop term1 (car lat)))]))
Those are both functions.
I need to replace an element from a list with another element in Scheme, but the problem is that the list where I need to replace can be nested.
For example, if I have the list '(1 (2 3 4 5) (6 7)) and I need to replace 5 with 9, my output should be '(1 (2 3 4 9) (6 7)).
Can you please help me with this problem?
There is a basic strategy for solving this kind of problem:
First, solve it for a flat list. i.e., write the function so that it works if the input list has no sublists.
Then, add a condition so that if the element you're inspecting is a list, then recurse into your function with that list.
Here's some skeletal code:
(define (replace lst from to)
(cond ((null? lst) '()) ;; end of input
((list? (car lst)) <???>) ;; encountered a sublist
((equal? (car lst) from) <???>) ;; found the element we're replacing
(else <???>))) ;; everything else
Notice that the second cond clause, (list? (car lst)), is the only thing that's new in your sublist-capable version.
here is a function:
(define (replace L new old)
(cond ;;((null? L) L)
((list? L)
(map
(lambda (lst) (replace lst new old))
L))
(else
(if (equal? L old)
new
L))))
examples of use:
> (replace '(1 (1 2 3 4 (5 6 3) 3 4)) 7 3)
'(1 (1 2 7 4 (5 6 7) 7 4))
> (replace '() 7 3)
'()
> (replace '(1 (1 2 3 4) 3 4) 7 3)
'(1 (1 2 7 4) 7 4)
or:
(define (replace L new old)
(if (list? L)
(map
(lambda (lst) (replace lst new old))
L)
(if (equal? L old)
new
L)))
example:
(replace '(1 (1 2 3 4 (5 6 3) 3 4)) 7 3) -> '(1 (1 2 7 4 (5 6 7) 7 4))
I'm trying to write a function that works like remove-duplicates, but it instead takes two lists as input, the first specifying characters for which duplication is not allowed, and the second being a list of various atoms which is to be pruned.
Currently I have this:
(defun like-remove-duplicates (lst1 lst2)
(if(member (first lst1) lst2)
(remove-if #'(lambda (a b)
(equals a b))lst1 lst2)))
I know it's not anywhere near right, but I can't figure out what I need to do to perform this function. I know I essentially need to check if the first item in list1 is in list2, and if so, remove its duplicates (but leave one) and then move onto the next item in the first list. I envisioned recursion, but it didn't turn out well. I've tried researching, but to no avail.
Any help?
CL-USER> (defun remove-duplicates-from-list (forbidden-list list)
(reduce (lambda (x y)
(let ((start (position y x)))
(if start
(remove y x :start (1+ start))
x)))
forbidden-list
:initial-value list))
REMOVE-DUPLICATES-FROM-LIST
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3))
(1 2 3)
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3 2))
(1 2 3)
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3 2 4))
(1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(1 2 1 3 2 4))
(1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 1 2 1 3 2 4))
(0 1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 2 3 2 4))
(0 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 2 2 3 4))
(0 2 3 4)
Recursion is performed by reduce (because here we have the most common recursion pattern: feed the result of previous iteration to the next) and removeing is done with the help of :start parameter, that is the offset after the first encounter (found by position) of the value being removed currently.
It's also important to account the case, when the value isn't found and position returns nil.
Something like this should work and have acceptable time-complexity (at the cost of soem space-complexity).
(defun like-remove-duplicates (only-once list)
"Remove all bar the first occurence of the elements in only-once from list."
(let ((only-once-table (make-hash-table))
(seen (make-hash-table)))
(loop for element in only-once
do (setf (gethash element only-once-table) t))
(loop for element in list
append (if (gethash element only-once-table)
(unless (gethash element seen)
(setf (gethash element seen) t)
(list element))
(list element)))))
This uses two state tables, both bounded by the size of the list of elements to include only once and should be roughly linear in the sum of the length of the two lists.
(defun remove-listed-dups (a b)
(reduce (lambda (x y) (if (and (find y a) (find y x)) x (cons y x)))
b :initial-value ()))