Removing all ()'s from a sublist in Racket - filter

I need to have the following program interaction:
(clean'(1 (2 () (3 () 4))()()(()) 5)) → (1 (2 (3 4)) 5)
This is what I have so far
define (emptyClear theList)
(cond ((null? theList) '())
((null? (car theList)) (emptyClear (cdr theList)))
(else (cons (car theList) (emptyClear (cdr theList))))))
(define (clean tree)
(cond ((null? tree) '())
((not (list? (car tree))) (cons (car tree) (prune (cdr tree))))
(cons (emptyClear (car tree)) (prune (cdr tree)))))
But this gives me: -> (1 5) as the output.
How can I solve this issue?

From the example the task seems to be not simply to remove empty lists from a tree, but to continue to perform this operation until possible (since '(())) is not an empty list, but it is removed nevertheless).
Here is a possible solution, tested with DrRacket.
(define (my-empty? x)
(cond ((null? x) #t)
((list? x) (andmap my-empty? x))
(else #f)))
(define (clean x)
(cond ((null? x) '())
((not (list? x)) x)
((my-empty? (car x)) (clean (cdr x)))
(else (cons (clean (car x)) (clean (cdr x))))))
(clean '(1 (2 () (3 () 4))()()((())) 5)) ;=> '(1 (2 (3 4)) 5)

Related

Deep recursion in Scheme

I have a problem with deep recursion in scheme
The output should be
(1 2 3 (4 5))
~> ((1) (2) (3) ((4) (5)))
But my output is (1 (2 (3 ((4 (5 ())) ())))).
It seems like the quote is at the wrong place
I got these
(define (DoublebubbleLst lst)
(cond ((null? lst) lst)
((not (pair? lst))
(append lst))
(else(list
(DoublebubbleLst (car lst))
(DoublebubbleLst (cdr lst))))))
And what's my problem
This seems to work:
(define (double-bubble-list lst)
(cond ((null? lst) lst)
((not (list? (car lst)))
(cons (list (car lst))
(double-bubble-list (cdr lst))))
(else (cons (double-bubble-list (car lst))
(double-bubble-list (cdr lst))))))
Example:
> (double-bubble-list '(1 2 3 (4 5)))
'((1) (2) (3) ((4) (5)))

Rotating a list to the right in scheme

if this is rotating a list to the left:
(define (rotate-left l)
(if (null? l)
'()
(append (cdr l) (cons(car l) '()))))
How would I rotate a list to the right?
If you're ok with writing a helper function to find the last element, it's pretty easy to do a recursive implementation:
(define rotate-right
(lambda (lis full)
(if (null? (cdr lis))
(cons (car lis) (get-all-but-last full))
(rotate-right (cdr lis) full))))
(define get-all-but-last
(lambda (lis)
(if (null? (cdr lis))
'()
(cons (car lis) (get-all-but-last (cdr lis))))))
Here is a short non-recursive solution:
(define (rotate-right l)
(let ((rev (reverse l)))
(cons (car rev) (reverse (cdr rev)))))
And here is a iterative solution:
(define (rotate-right l)
(let iter ((remain l)
(output '()))
(if (null? (cdr remain))
(cons (car remain) (reverse output))
(iter (cdr remain) (cons (car remain) output)))))
(rotate-right '(1 2 3 4 5)) ;==> (5 1 2 3 4)

Scheme - how to not 'flattened' pairs in list?

My task is to get first atom in structure, that's why I'm used flatten and func "first-atom-lst". But there is one big problem - I need to handle pairs in structure and do NOT broke pairs. Can you please help me to handle this?
(define (check-improper? lst)
(cond
((null? lst) #f)
((number? lst) #f)
((atom? lst) #f)
((list? lst) #f)
((pair? (cdr lst)) #t)
(#t #f)
))
(define (improper-to-proper lst)
(cond
((null? lst) '())
((not (pair? (cdr lst))) (cons lst '()))
(else (cons (car lst) (improper-to-proper (cdr lst))))
)
)
(define (first-atom-from-pair lst)
(cond ((check-improper? lst))
((null? lst) #f)
((atom? (car (flatten lst)))
(car (flatten lst)))
(else
(first-atom (cdr (flatten lst))))))
(define (first-atom lst)
(cond ((check-improper? lst))
((null? lst) #f)
((atom? lst) lst)
((pair? (cdr lst)) (first-atom-from-pair lst))
((pair? lst) #f)
((atom? (car (flatten (not pair? lst))))
(car (flatten (not pair? lst))))
(else
(first-atom (cdr (flatten lst))))))
You cannot flatten improper lists, but it's actually overkill in your case anyway. You could do something like this:
(define (first-atom tree)
(if (null? tree)
#f
(if (pair? tree)
(first-atom (car tree))
tree)))
then
> (first-atom '((2 . 0) 2))
2
> (first-atom '((1 . 0) (2 . 3) 2))
1
> (first-atom '((2 . 1) (2 3) 1))
2
> (first-atom '(((((((1 . 2) 3) 4))))))
1
Note that my second result differs from yours, but I believe mine is correct since the first element of a flattened list would also yield 1.
Solve problem, but need improvement.
(define (atom? a)
(and (not (pair? a))
(not (null? a))))
(define (true-pair? p)
(cond
((list? p) #f)
((pair? (cdr p)) #f)
(else #t)))
(define (flatten-atom x)
(cond ((null? x) '())
((atom? x) (list x))
((true-pair? x) (list x))
(else (append (flatten-atom (car x))
(flatten-atom (cdr x))))))
(flatten-atom '((a b . c)))
(flatten-atom '((a b c) d e () ((f)) (1 . 2)))
(flatten-atom '((a b . c) (((4 5))) () 6 (7 . 8)))
> (a (b . c))
> (a b c d e f (1 . 2))
> (a (b . c) 4 5 6 (7 . 8))

Scheme: Searching element in a list and sublist

I want to write a function that receives list and returns a list of each element.
For example:
get - (x 3 4 5 (x 4) 3 x (6))) and receive: (x (x) x ())
(define (lookForX lst)
(cond
((null? lst) '())
((eq? (car lst) 'x) (cons (car lst) (lookForX (cdr lst))) )
(else (lookForX (cdr lst)))))
my code result for:
(lookForX '(x 3 4 5 (x 4) 3 x (6)))
-> (x x)
What am I doing wrong?
In you function you are only looking for x as element in the list and you are not doing sub lists:
(define (filter-x lst)
(cond
((null? lst) '())
((eq? (car lst) 'x)
(cons (car lst)
(filter-x (cdr lst))))
((pair? (car lst))
(cons (filter-x (car lst))
(filter-x (cdr lst))))
(else (filter-x (cdr lst)))))
(filter-x '(x 3 4 5 (x 4) 3 x (6)))
; ==> (x (x) x ())
Notice I renamed this to be more lisp like. Lisp code usually don't use camelCase but lisp-case. You can do it more general:
(define (filter-tree predicate? lst)
(cond
((null? lst) '())
((predicate? (car lst))
(cons (car lst)
(filter-tree predicate? (cdr lst))))
((pair? (car lst))
(cons (filter-tree predicate? (car lst))
(filter-tree predicate? (cdr lst))))
(else (filter-tree predicate? (cdr lst)))))
(define (filter-tree-x lst)
(filter-tree (lambda (v) (eq? v 'x)) lst))
(filter-tree-x '(x 3 4 5 (x 4) 3 x (6)))
; ==> (x (x) x ())
(define (filter-tree-numbers lst)
(filter-tree number? lst))
(filter-tree-numbers '(x 3 4 5 (x 4) 3 x (6)))
; ==> (3 4 5 (4) 3 (6))

going through a list retrieving other list

(define *graph* (read (open-input-file "test.sxml")))
(define get
(lambda (l)
(cond ((null? l) '())
((equal? 'opm:artifacts (car l)) l)
(else (get (cdr l))))))
(get *graph*)
I have this recursive function that goes through the list and returns the rest of a list that starts with "opm:artifacts".
It works on other lists.
For example, it works for the list (1 2 3 4); when I call the function,
(get 2) returns (2 3 4).
test.sxml is a list. I checked it with list?.
(define (get l)
(match l
[(? null?) '()]
[(list 'opm:artifacts _ ...) l]
[(list _ rs ...) (get rs)]))
(define (get mat ls*)
(define (get* ls)
(cond ((null? ls) '())
((and (list? (car ls)) (not (null? (car ls))))
(if (equal? mat (caar ls))
(car ls)
(let ((sub-result (get* (car ls))))
(if (null? sub-result)
(get* (cdr ls))
sub-result))))
(else (get* (cdr ls)))))
(let ((result (get* ls*)))
(if (null? result)
'()
(cdr result))))
(get 'b '(a (b c d) e)) ;-> '(c d)
(get 'b '((a (b c d) e))) ;-> '(c d)
(get '() '( 4 6 () (2 ()) (() () ()))) ;-> '(() ())
I've also generalized it so you can hand in what you want it to match against.

Resources