I want to calculate the maximum of every sublist/level/superficial level from a list of number
Ex: (1 2 5 (4 2 7 (4 6) 9) 7 8) => (8 9 6)
What I have now is:
maximum (l) ;;function to compute the maximum number for a simple list, it works
(defun max-superficial (lista acc acc2) ;;main function: lista - my list, acc - my final list
;;of results, acc2 - accumulation list for a sublist
(typecase lista
(null
(typecase acc2
;; if my list is empty and I have nothing accumulated, just return the final list
(null acc)
;;if my list is empty but I have something in my accumulation list, just add the maximum
;;of acc2 to my final list
(t (nconc acc (list (maximum acc2))))))
(cons (destructuring-bind (head . tail) lista
(typecase head
(list
;;if my list isn't empty and the head of the list is a list itself, call
;;the function again for the head with an empty accumulation list and then call it again
;;for the tail
(nconc acc
(list (max-superficial head acc nil))
(max-superficial tail acc acc2)))
;; otherwise just accumulate the head and call the function for the tail
---problem here (t (nconc acc2 (list head))
(print '(wtf))
(print acc)
(print acc2)
(print head)
(max-superficial tail acc acc2)))))))
The problem is that I only wrote this program and I want to test it and on the list "---problem here" it won't add my head to the accumulation list.
For: (max-superficial '(1 2) nil nil) --result should be ==> wtf nil (1) 1 wtf nil (1 2) 2 2
My result: wtf nil nil 1 wtf nil nil 2 nil
I checked separately and (nconc some-list (list 3)) does exactly what it's supposed to... adds the number 3 to the back of the some-list. I don't know why nconc acc2 (list head) doesn't work
Tried replacing nconc with append and it's not working either. Apparently, you can't add an element to an empty list using append/nconc. Then how?
A simpler implementation:
(defun max-superficial/sublists (list)
(loop for num in list
if (listp num) append (max-superficial/sublists num) into sublists
else if (numberp num) maximize num into max
else do (error "Not a number or list: ~a" num)
finally (return (cons max sublists))))
;; If you want the max of each "level" or depth in a tree,
;; then you need to be able to operate on levels. Here are some
;; functions that are analogous to FIRST, REST, and POP:
(defun top-level (tree)
(remove-if-not #'numberp tree))
(defun rest-levels (tree)
(apply #'append (remove-if-not #'listp tree)))
(defmacro pop-level (tree)
`(let ((top (top-level ,tree)))
(setf ,tree (rest-levels ,tree))
top))
(defun max-superficial (tree &key use-sublists)
"It wasn't clear if you wanted the max in each sublist or the max
at each depth, so both are implemented. Use the :use-sublists key
to get the max in each sublist, otherwise the max at each depth
will be computed."
(if use-sublists
(max-superficial/sublists tree)
(loop for top-level = (pop-level tree)
collect (if top-level (reduce #'max top-level)) into result
unless tree do (return result))))
Here's a (not particularly efficient) solution:
(defun max-avoiding-nil (a b)
(cond ((null a) b)
((null b) a)
(t (max a b))))
(defun depth-maximum (a b)
(cond ((null a) b)
((null b) a)
(t
(cons (max-avoiding-nil (car a) (car b))
(depth-maximum (cdr a) (cdr b))))))
(defun tree-max-list (list depth)
(reduce #'depth-maximum tree
:key (lambda (elt) (tree-max elt depth))
:initial-value '()))
(defun tree-max (tree depth)
(if (listp tree)
(tree-max-list tree (1+ depth))
(append (make-list depth 'nil) (list tree))))
(defun tree-maximums (tree)
(tree-max-list tree 0))
(tree-maximums '(1 2 5 (4 2 7 (4 6) 9) 7 8)) => (8 9 6)
(tree-maximums '()) => nil
(tree-maximums '(1)) => (1)
(tree-maximums '((2))) => (nil 2)
(tree-maximums '((2) (3))) => (nil 3)
Related
How do I recursively merge jumping pairs of elements of a list of lists? I need to have
'((a b c) (e d f) (g h i))
from
'((a b) c (e d) f (g h) i)
My attempt
(define (f lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (append (car lst) (list (cadr lst)))
(list (append (caddr lst) (cdddr lst))))))
works if I define
(define listi '((a b) c (d e) f))
from which I obtain
((a b c) (d e f))
by doing simply
(f listi)
but it does not work for longer lists. I know I need recursion but I don't know where to insert f again in the last sentence of my code.
A simpler case that your algorithm fails: (f '((1 2) 3)) should result in '((1 2 3)), but yours results in an error.
We will define some terms first:
An "element" is a regular element, like 1 or 'a.
A "plain list" is simply a list of "element"s with no nested list.
E.g., '(1 2 3) is a plain list. '((1 2) 3) is not a plain list.
A "plain list" is either:
an empty list
a cons of an "element" and the next "plain list"
A "list of jumping pairs" is a list of even length where the odd index has a "plain list", and the even index has an element. E.g., '((1) 2 (a) 4) is a "list of jumping pairs". A "list of jumping pairs" is either:
an empty list
a cons of
a "plain list"
a cons of an "element" and the next "list of jumping pairs"
We are done with terminology. Before writing the function, let's start with some examples:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
(f '((1 2) 3 (4) a)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
(cons (cons 4 empty)
(cons 'a
empty)))))
should output '((1 2 3) (4 a))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
(cons (cons 4 (cons 'a empty))
empty))
So, f is a function that consumes a "list of jumping pairs" and returns a list of "plain list".
Now we will write the function f:
(define (f lst)
???)
Note that the type of lst is a "list of jumping pairs", so we will perform a case analysis on it straightforwardly:
(define (f lst)
(cond
[(empty? lst) ???] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
we know that the empty case should return an empty list, so let's fill in the hole accordingly:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
we know that we definitely want to put the "element" into the back of the "plain list" to obtain the resulting "plain list" that we want:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the next "list of jumping pairs"
(rest (rest lst))
;; that are available for us to use
???]))
There's still the next "list of jumping pairs" left that we need to deal with, but we have a way to deal with it already: f!
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the list of "plain list"
(f (rest (rest lst)))
;; that are available for us to use
???]))
And then we can return the answer:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case returns
;; the resulting list of "plain list" that we want
(cons (append (first lst) (cons (first (rest lst)) empty))
(f (rest (rest lst))))]))
Pattern matching (using match below) is insanely useful for this kind of problem -
(define (f xs)
(match xs
;; '((a b) c . rest)
[(list (list a b) c rest ...)
(cons (list a b c)
(f rest))]
;; otherwise
[_
empty]))
define/match offers some syntax sugar for this common procedure style making things even nicer -
(define/match (f xs)
[((list (list a b) c rest ...))
(cons (list a b c)
(f rest))]
[(_)
empty])
And a tail-recursive revision -
(define (f xs)
(define/match (loop acc xs)
[(acc (list (list a b) c rest ...))
(loop (cons (list a b c) acc)
rest)]
[(acc _)
acc])
(reverse (loop empty xs)))
Output for each program is the same -
(f '((a b) c (e d) f (g h) i))
;; '((a b c) (e d f) (g h i))
(f '((a b) c))
;; '((a b c))
(f '((a b) c x y z))
;; '((a b c))
(f '(x y z))
;; '()
(f '())
;; '()
As an added bonus, this answer does not use the costly append operation
There is no recursive case in your code so it will just work statically for a 4 element list. You need to support the following:
(f '()) ; ==> ()
(f '((a b c) d (e f g) h)) ; ==> (cons (append '(a b c) (list 'd)) (f '((e f g) h)))
Now this requires exactly even number of elements and that every odd element is a proper list. There is nothing wrong with that, but onw might want to ensure this by type checking or by adding code for what should happen when it isn't.
I wish to create a function in Scheme that takes in a predicate and a list of elements, and then outputs two separate lists. One with elements of the original list that MATCH the given predicate, and one with elements that DON'T match it.
The code I have right now I believe should isolate those which match the predicate and output a list of them but the code will not work.
(define tear
(lambda (pred xs)
(cond[(null? xs) '()]
[(list? (car xs))(cons((tear (pred (car xs)))(tear (pred (cdr xs)))))]
[(pred (car xs))(cons((car xs)(tear (pred (cdr xs)))))]
[else tear (pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
The resulting output on my compiler is:
tear: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
#f
context...:
/home/jdoodle.rkt:2:4: tear
Command exited with non-zero status 1
Any help/info that you can give would be much appreciated.
Lets fix your code step by step. Adding indentation and whitespace to make it readable:
(define tear
(lambda (pred xs)
(cond
[(null? xs)
'()]
[(list? (car xs))
(cons ((tear (pred (car xs))) (tear (pred (cdr xs)))))]
[(pred (car xs))
(cons ((car xs) (tear (pred (cdr xs)))))]
[else
tear (pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
The first problem I see is a problem of putting parentheses on the inside (around the arguments) of a function call instead on the outside. You do this with cons and with the recursive calls to tear. For instance in tear (pred (cdr xs)) you should move the first paren to before the function. Remember that parentheses in an expression almost always mean a function call in the shape of (function argument ...).
(cons (A B)) should be rewritten to (cons A B)
(tear (Pred Xs)) should be rewritten to (tear Pred Xs)
tear (Pred Xs) should be rewritten to (tear Pred Xs)
With these fixes your code looks like this:
(define tear
(lambda (pred xs)
(cond
[(null? xs)
'()]
[(list? (car xs))
(cons (tear pred (car xs)) (tear pred (cdr xs)))]
[(pred (car xs))
(cons (car xs) (tear pred (cdr xs)))]
[else
(tear pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
;=> (1 2 3)
(tear number? '(1 2 "not a number" 3 4))
;=> (1 2 3 4)
However, it still does something weird when there's a nested list:
(tear list? (list '(1 2 3) "not a list" '(4 5)))
;=error> (() ())
To be consistent it should put the two lists into a list: ((1 2 3) (4 5)). To do that just remove the second cond case:
(define tear
(lambda (pred xs)
(cond
[(null? xs)
'()]
[(pred (car xs))
(cons (car xs) (tear pred (cdr xs)))]
[else
(tear pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
;=> (1 2 3)
(tear list? (list '(1 2 3) "not a list" '(4 5)))
;=> ((1 2 3) (4 5))
It now seems to do exactly half of what you want. You want it to return two lists: one for elements that passed, and one for the elements that failed. It currently is returning just the first list.
The first thing you should do is document how it returns those two lists. Since there are always exactly two, you can return them as multiple values.
;; tear returns two values:
;; - a list of the elements of `xs` that passed `pred`
;; - a list of the elements of `xs` that failed `pred`
There are two parts of using multiple values: returning them and receiving them. Use (values A B) to return them, and (let-values ([(A B) ....]) ....) to match on a result, like the result of a recursive call.
That means every recursive call like this (f .... (tear ....) ....) should become
(let-values ([(A B) (tear ....)])
(values (f .... A ....)
???))
Applying that to your code:
;; tear returns two values:
;; - a list of the elements of `xs` that passed `pred`
;; - a list of the elements of `xs` that failed `pred`
(define tear
(lambda (pred xs)
(cond
[(null? xs)
(values '()
???)]
[(pred (car xs))
(let-values ([(A B) (tear pred (cdr xs))])
(values (cons (car xs) A)
???))]
[else
(let-values ([(A B) (tear pred (cdr xs))])
(values A
???))])))
Now to fill in the ??? holes, use examples.
(tear number? '()) should return two empty lists: () ()
(tear number? '(1 2)) should return a full list and an empty list: (1 2) ()
(tear number? '(a b)) should return an empty list and a full list: () (a b)
The first example corresponds to the first ??? hole, the second example corresponds to the second hole, and so on.
This tells us that the first hole should be filled in with '(), the second hole should be filled in with B, and the third hole should be filled in with (cons (car xs) B).
(define tear
(lambda (pred xs)
(cond
[(null? xs)
(values '() '())]
[(pred (car xs))
(let-values ([(A B) (tear pred (cdr xs))])
(values (cons (car xs) A)
B))]
[else
(let-values ([(A B) (tear pred (cdr xs))])
(values A
(cons (car xs) B)))])))
(tear number? '(1 2 3 a b c))
;=> (1 2 3)
; (a b c)
(tear list? (list '(1 2 3) "not a list" '(4 5)))
;=> ((1 2 3) (4 5))
; ("not a list")
This is a classic fold use-case. You're aggregating the list into two lists :
(define tear (lambda (pred lst)
(fold-right ; Aggregate over lst
(lambda (elem agg)
(let ((accepted (car agg))
(rejected (cadr agg)))
(if (pred elem)
; Create a new agg by adding the current element to the accepted list
`(,(cons elem accepted) ,rejected)
; Or, if the predicate rejected the element,
; Create a new agg by adding the current element to the rejected list
`(,accepted ,(cons elem rejected)))))
`(() ())
lst)))
So, if you use even? as your predicate, you can get:
> (tear even? `(1 2 3 4 5 6 7 8))
((2 4 6 8) (1 3 5 7))
Here's another way you can do it using continuation-passing style; this puts the recursive call in tail position.
(define (partition p xs (return list))
(if (null? xs)
(return null null)
(partition p
(cdr xs)
(lambda (t f)
(if (p (car xs))
(return (cons (car xs) t)
f)
(return t
(cons (car xs) f)))))))
(partition number? '())
;; => '(() ())
(partition number? '(a 1 b 2 c 3))
;; => '((1 2 3) (a b c))
(partition list? '(1 2 (3 4) (5 6) 7 8))
;; => '(((3 4) (5 6)) (1 2 7 8))
Above, we make use of Racket's default arguments. Below we show how to define partition using a helper function instead
;; procedure above, renamed to partition-helper
(define (partition-helper p xs return)
...)
;; new procedure without optional parameter
(define (partition p xs)
;; call helper with default continuation, list
(partition-helper p xs list))
Comments may help distill some of the style's mysterious nature
;; default continuation is `list`, the list constructor procedure
(define (partition p xs (return list))
(if (null? xs)
;; base case: empty list; return the empty result
(return null null)
;; inductive case: at least one x; recur on the tail...
(partition p
(cdr xs)
;; ...specifying how to continue the pending computation
(lambda (t f)
(if (p (car xs))
;; if predicate passes, cons x onto the t result
(return (cons (car xs) t)
f)
;; otherwise cons x onto the f result
(return t
(cons (car xs) f)))))))
#WillNess asks why we delay evaluating the predicate; I don't have a reason other than I think the readability above is pretty good. We can alter the implementation to check the predicate right away, if we please. The impact here is very subtle. If you don't see it, I encourage you to play pen-and-paper evaluator and compare the two processes to understand it.
;; default continuation is `list`, the list constructor procedure
(define (partition p xs (return list))
(if (null? xs)
;; base case: empty list; return the empty result
(return null null)
;; inductive case: at least one x; recur on the tail...
(partition p
(cdr xs)
;; ...specifying how to continue the pending computation
(if (p (car xs))
(lambda (t f)
;; if predicate passes, cons x onto the t result
(return (cons (car xs) t)
f))
(lambda (t f)
;; otherwise cons x onto the f result
(return t
(cons (car xs) f)))))))
Having nested lists as the input, I'm trying to find how to output the number of 'siblings' an element has. In terms of trees, how many other leaf nodes belong to the same parent/root node.
My code is giving the wrong outputs (it's a really bad code) and I'm not sure how to entirely approach the question
(define (siblings lst n)
(cond
[(empty? lst) false]
[(member? n lst) (sub1 (length lst))]
[else (siblings (rest lst) n)]))
sample outcomes: if given (list (list 2 1) 3 (list 4)) and 3, produce 0
(list (list 1 2 3) (list (list 4 5 6 ))) and 5 -> 2
Your code has to do two separate things:
Find the branch that contains n
Count the number of siblings in that branch, accounting for the possibility of other branches starting there.
Finding the branch that contains n, assuming that n can only appear once:
(define (find-branch root n)
(cond ((empty? root) empty)
((memq n root)
root)
((list? (first root))
(let ((subresult (find-branch (first root) n)))
(if (not (empty? subresult))
subresult
(find-branch (rest root) n))))
(else (find-branch (rest root) n))))
Since you're using "Beginning Student," that takes all the tools out of your toolbox. Fortunately, it still has number?, so if it's safe to assume that anything that isn't a number in this assignment is a list, you can define list? like this:
(define (list? n) (not (number? n)))
Given your example tree as input, it would return:
(4 5 6)
The above example unnecessarily uses memq repeatedly on the rest of the
input list as a result of using recursion to iterate over the same list.
Here's a more efficient version of the above, but you can't implement it in Beginning Student:
(define (find-branch root n)
(cond ((empty? root) false)
((memq n root) root)
(else (foldl (λ (a b)
(if (empty? a) b a))
empty
(map (λ (sublist)
(find-branch sublist n))
(filter list? root))))))
You pass the result of that to a function to count the siblings. I previously provided a version that would work in the real Racket, but not the Beginning Student version used by teachers:
(define (count-siblings root mem)
(count (λ (sib)
(and (not (eq? sib mem))
(not (list? sib)))) root))
Here's a version that's compatible with Beginning Student:
(define (count-siblings lst n counter)
(cond
[(empty? lst) counter]
[(and (not (list? (first lst)))
(not (eq? n (first lst))))
(count-siblings (rest lst) n (add1 counter))]
[else (count-siblings (rest lst) n counter)]))
Finally, put the two together:
(define (find/count-siblings root n)
(count-siblings (find-branch root n) n 0))
I'm new in Lisp and I'm trying to return the list of the first elements of all list elements of
a given list with an odd number of elements at superficial level.
Example: (1 2 (3 (4 5) (6 7)) 8 (9 10 11)) => (1 3 9).
This is what I've come up with:
(defun firstEl(L1)
(cond
((null L1)
nil
)
((LISTP (List L1))
(firstEl (rest L1))
(append (List L2) (first L1))
)
(t
(firstEl (rest L1) L2)
)
)
)
Thanks a lot.
I often find functions such as mapcan useful for recursive list processing:
(defun firstEl (value)
;;(print value)
(if (listp value)
(let ((first-value (first value))
(tail (mapcan #'firstEl value)))
(if (and (numberp first-value)
(oddp first-value))
(cons first-value tail)
tail))
'()))
Trying to learn lisp, want to delete every nth. I only managed to delete the first (nth) element
(defun delete-nth (n list)
(if (zerop n)
(cdr list)
(let ((cons (nthcdr (1- n) list)))
(if cons
(setf (cdr cons) (cddr cons))
cons))))
I'd like to delete the next nth and so on
Also I tried this:
(defun remove-nth (list n)
(remove-if (constantly t) list :start n :end (+ 1 n)))
No idea how to start again
What I was thinking was concatenating, but I have no idea of how to keep track of my position.
Counting from 1 (changing to 0 is trivial):
(defun remove-every-nth (n list)
(loop for element in list
for index from 1
unless (zerop (rem index n))
collect element))
Also: Please indent your code correctly.
An alternative way to do the same thing:
(defun remove-all-nth (list period)
(remove-if
(let ((iterator 0))
(lambda (x)
(declare (ignore x))
(= 0 (mod (incf iterator) period)))) list))
(remove-all-nth '(1 2 3 4 5 6 7 8 9 0) 3)
; (1 2 4 5 7 8 0)
Perhaps a more academic recursive solution here:
(defun delete-nth (n list)
(labels ((rec (i list)
(cond ((null list) nil)
((= i 1) (rec n (cdr list)))
(t (cons (car list) (rec (1- i) (cdr list)))))))
(rec n list)))
But in real life I'd use the loop option above.