I have a list of the form:
((1 (3 2 4)) (2 (3 1)) (3 (2 1)) (4 (1)))
This list represents a graph of the form("node" ("edges")). How might I approach writing a procedure that takes a value representing an node, for example "1", and removes that node from the graph. For example: (delete-node n g) with input 5 and '((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 (5)) (5 (4))) should output:
((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 ()))
As can be observed from the example above, the node and any edges added to that node must both be removed. My code thus far is as follows:
(define graph '((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 (5)) (5 (4))))
;...Other procedures not shown...
(define (delete-node n g)
(define (delete ls item)
(cond ((null? ls) nil)
((pair? (car ls))
(cons (delete (car ls) item) (delete (cdr ls) item)))
((equal? (car ls) item) (delete (cdr ls) item))
(else (cons (car ls) (delete (cdr ls) item)))))
(delete (filter (lambda (x) (not (eq? (car x) n))) g) n))
(delete-node 5 graph)
The above code works, but is there a more efficient way of doing this?
A possible definition using high-level functions is the following:
(define (delete-node n g)
(map (lambda(x) (list (car x) (filter (lambda(x) (not (= x n))) (cadr x))))
(filter (lambda(x) (not (= (car x) n))) g)))
(delete-node 5 '((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 (5)) (5 (4))))
; produces ((1 (3 2)) (2 (3 1)) (3 (2 1)) (4 ()))
A slightly more efficient solution with a recursive function is instead the following:
(define (delete-node n g)
(cond ((null? g) '())
((= (caar g) n) (delete-node n (cdr g)))
(else (cons (list (caar g) (filter (lambda(x) (not (= x n))) (cadar g)))
(delete-node n (cdr g))))))
If the graph is large and you know that its structure is correct,
knowing that only one outgoing arc from a node can be equal to n, a more efficient version could be the following:
(define (delete-node n g)
(define (delete-edge edges)
(cond ((null? edges) '())
((= (car edges) n) (cdr edges)) ; stop recursion when the edge is found
(else (delete-edge (cdr edges)))))
(cond ((null? g) '())
((= (caar g) n) (delete-node n (cdr g)))
(else (if (member n (cadar g) =)
(cons (list (caar g) (delete-edge (cadar g)))
(delete-node n (cdr g)))
(cons (car g) (delete-node n (cdr g)))))))
Note that the test (member n (cadar g) =) is done to avoid copying the list of edges when n is not present.
Not sure whether I understand your question correctly - does this match your needs?
(define (delete-node node graph)
(define node-1 (car node))
(define node-2 (cdr node))
(let iter ((graph graph) (result '()))
(if (null? graph)
(reverse result)
(let* ((head (car graph)) (head-1 (car head)) (head-2 (cadr head)))
(iter (cdr graph)
(cons (cond
((eqv? head-1 node-1) (list head-1 (remove node-2 head-2)))
((eqv? head-1 node-2) (list head-1 (remove node-1 head-2)))
(else head))
result))))))
Testing:
> (delete-node '(2 . 3) '((1 (3 2 4)) (2 (3 1)) (3 (2 1)) (4 (1))))
'((1 (3 2 4)) (2 (1)) (3 (1)) (4 (1)))
> (delete-node '(1 . 2) '((1 (3 2 4)) (2 (3 1)) (3 (2 1)) (4 (1))))
'((1 (3 4)) (2 (3)) (3 (2 1)) (4 (1)))
Related
(define (all-sublists buffer n)
(cond ((= n 0) n)
((all-sublists (append buffer (list (list n)) (map (lambda (x) (append (list n) x)) buffer)) (- n 1)))))
the result looks like this:
(all-sublists '((3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)) 0)
when there is only one list around n:
(define (all-sublists buffer n)
(cond ((= n 0) n)
((all-sublists (append buffer (list n) (map (lambda (x) (append (list n) x)) buffer)) (- n 1)))))
the results get a dotted pair:
(all-sublists '(3 2 (2 . 3) 1 (1 . 3) (1 . 2) (1 2 . 3)) 0)
Is not that you have "to surround n with list twice to get the proper result", the truth is that there are several problems with your code, for starters: the last condition of a cond should start with an else, and you're using append incorrectly. If I understood correctly, you just want the powerset of a list:
(define (powerset aL)
(if (empty? aL)
'(())
(let ((rst (powerset (rest aL))))
(append (map (lambda (x) (cons (first aL) x))
rst)
rst))))
Like this:
(powerset '(1 2 3))
=> '((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) ())
(define unzip (lambda (l)
(define front (lambda (a)
(if (null? a)
'()
(cons (car (car a)) (unzip (cdr a)))
)))
(define back (lambda (b)
(if (null? b)
'()
(cons (car (cdr (car b))) (unzip (cdr b)))
)))
(list (front l) (back l))))
(unzip '((1 2) (3 4) (5 6)))
this call is supposed to return ((1 3 5) (2 4 6))
and if I replace the last line of code "(list (front l) (back l)) with just (front l) or (back l) i get the correct lists but i cant seem to put them together it justs keeps spitting out weird outputs every time i try.
Your code structure is very unconventional and I suspect you're rather new to scheme/racket. Your procedure can be written in a much more idiomatic way.
The first criticism I'd probably make about your code is that it makes the assumption that the lists you're unzipping will only have 2 elements each.
What about unzipping 3 lists of 5 elements or 5 lists of 3 elements ?
What about unzipping 4 lists of 4 elemens ?
What about unzipping 1 list of 7 elements or 7 lists of 1 element ?
What about unzipping nothing ?
These questions all point to a fundamental concept that helps shape well-structured procedures:
"What is a "total" procedure ?"
A total procedure is one that is defined for all values of an accepted type. What that means to us is that, if we write an unzip procedure, it should
accept an empty list
accept any number of lists
accept lists of any length1
Let's take a look at an unzip procedure that does that now. It's likely this procedure can be improved, but at the very least, it's easy to read and comprehend
(define (unzip xs (ys empty))
; if no xs are given, return ys
(cond [(empty? xs) empty]
; if the first input is empty, return the final answer; reversed
[(empty? (car xs)) (reverse ys)]
; otherwise, unzip the tail of each xs, and attach each head to ys
[else (unzip (map cdr xs) (cons (map car xs) ys))]))
(unzip '((1 2) (3 4) (5 6)))
; => '((1 3 5) (2 4 6))
Let's step through the evaluation.
; initial call
(unzip '((1 2) (3 4) (5 6)))
; (empty? xs) nope
; (empty? (car xs)) nope
; (unzip (map cdr xs) (cons (map car xs) ys))
; substitue values
(unzip (map cdr '((1 2) (3 4) (5 6)))
(cons (map car '((1 2) (3 4) (5 6))) empty))
; eval (map cdr xs)
(unzip '((2) (4) (6))
(cons (map car '((1 2) (3 4) (5 6))) empty))
; eval (map car xs)
(unzip '((2) (4) (6))
(cons '(1 3 5) empty))
; eval cons
; then recurse unzip
(unzip '((2) (4) (6))
'((1 3 5)))
; (empty? xs) nope
; (empty? (car xs)) nope
; (unzip (map cdr xs) (cons (map car xs) ys))
; substitue values
(unzip (map cdr '((2) (4) (6)))
(cons (map car '((2) (4) (6))) '((1 3 5))))
; eval (map cdr xs)
(unzip '(() () ())
(cons (map car '((2) (4) (6))) '((1 3 5))))
; eval (map car xs)
(unzip '(() () ())
(cons '(2 4 5) '((1 3 5))))
; eval cons
; then recurse
(unzip '(() () ())
'((2 4 5) (1 3 5)))
; (empty? xs) nope
; (empty? (car xs)) yup!
; (reverse ys)
; substituion
(reverse '((2 4 5) (1 3 5)))
; return
'((1 3 5) (2 4 5))
Here's another thing to think about. Did you notice that unzip is basically doing the same thing as zip ? Let's look at your input little closer
'((1 2)
(3 4)
(5 6))
^ ^
Look at the columns. If we were to zip these, we'd get
'((1 3 5) (2 4 6))
"Wait, so do you mean that a unzip is just another zip and vice versa ?"
Yup.
(unzip '((1 2) (3 4) (5 6)))
; => '((1 3 5) (2 4 6))
(unzip (unzip '((1 2) (3 4) (5 6))))
; '((1 2) (3 4) (5 6))
(unzip (unzip (unzip '((1 2) (3 4) (5 6)))))
; '((1 3 5) (2 4 6))
Knowing this, if you already had a zip procedure, your definition to unzip becomes insanely easy
(define unzip zip)
Which basically means:
You don't need an unzip procedure, just re-zip it
(zip '((1 2) (3 4) (5 6)))
; => '((1 3 5) (2 4 6))
(zip (zip '((1 2) (3 4) (5 6))))
; '((1 2) (3 4) (5 6))
(zip (zip (zip '((1 2) (3 4) (5 6)))))
; '((1 3 5) (2 4 6))
Anyway, I'm guessing your unzip procedure implementation is a bit of homework. The long answer your professor is expecting is probably something along the lines of the procedure I originally provided. The sneaky answer is (define unzip zip)
"So is this unzip procedure considered a total procedure ?"
What about unzipping 3 lists of 5 elements or 5 lists of 3 elements ?
(unzip '((a b c d e) (f g h i j) (k l m n o p)))
; => '((a f k) (b g l) (c h m) (d i n) (e j o))
(unzip '((a b c) (d e f) (g h i) (k l m) (n o p)))
; => '((a d g k n) (b e h l o) (c f i m p))
What about unzipping 4 lists of 4 elemens ?
(unzip '((a b c d) (e f g h) (i j k l) (m n o p)))
; => '((a e i m) (b f j n) (c g k o) (d h l p))
What about unzipping 1 list of 7 elements or 7 lists of 1 element ?
(unzip '((a b c d e f g)))
; => '((a) (b) (c) (d) (e) (f) (g))
(unzip '((a) (b) (c) (d) (e) (f) (g)))
; => '((a b c d e f g))
What about unzipping nothing ?
(unzip '())
; => '()
What about unzipping 3 empty lists ?
(unzip '(() () ()))
; => '()
1 We said that unzip should "accept lists of any length" but we're bending the rules just a little bit here. It's true that unzip accepts lists of any length, but it's also true that each list much be the same length as the others. For lists of varying length, an objective "correct" solution is not possible and for this lesson, we'll leave the behavior for mixed-length lists as undefined.
; mixed length input is undefined
(unzip '((a) (b c d) (e f))) ; => ???
A couple side notes
Things like
(car (car x))
(car (cdr (car x)))
Can be simplified to
(caar x)
(cadar x)
The following pair accessor short-hand procedures exist
caar ; (car (car x))
cadr ; (car (cdr x))
cdar ; (cdr (car x))
cddr ; (cdr (cdr x))
caaar ; (car (car (car x)))
caadr ; (car (car (cdr x)))
cadar ; (car (cdr (car x)))
caddr ; (car (cdr (cdr x)))
cdaar ; (cdr (car (car x)))
cdadr ; (cdr (car (cdr x)))
cddar ; (cdr (cdr (car x)))
cdddr ; (cdr (cdr (cdr x)))
caaaar ; (car (car (car (car x))))
caaadr ; (car (car (car (cdr x))))
caadar ; (car (car (cdr (car x))))
caaddr ; (car (car (cdr (cdr x))))
cadaar ; (car (cdr (car (car x))))
cadadr ; (car (cdr (car (cdr x))))
caddar ; (car (cdr (cdr (car x))))
cadddr ; (car (cdr (cdr (cdr x))))
cdaaar ; (cdr (car (car (car x))))
cdaadr ; (cdr (car (car (cdr x))))
cdadar ; (cdr (car (cdr (car x))))
cdaddr ; (cdr (car (cdr (cdr x))))
cddaar ; (cdr (cdr (car (car x))))
cddadr ; (cdr (cdr (car (cdr x))))
cdddar ; (cdr (cdr (cdr (car x))))
cddddr ; (cdr (cdr (cdr (cdr x))))
It is combining the lists correctly, but it's not combining the correct lists.
Extracting the local definitions makes them testable in isolation:
(define (front a)
(if (null? a)
'()
(cons (car (car a)) (unzip (cdr a)))))
(define (back b)
(if (null? b)
'()
(cons (car (cdr (car b))) (unzip (cdr b)))))
(define (unzip l)
(list (front l) (back l)))
(define test '((1 2) (3 4) (5 6)))
Test:
> (front test)
'(1 (3 (5 () ()) (6 () ())) (4 (5 () ()) (6 () ())))
> (front '((1 2)))
'(1 () ())
> (back '((1 2)))
'(2 () ())
Weird...
> (unzip '())
'(() ())
> (unzip '((1 2)))
'((1 () ()) (2 () ()))
It looks like something is correct, but the lists' tails are wrong.
If you look carefully at the definitions of front and back, they're recursing to unzip.
But they should recurse to themselves - front is the "first first" followed by the rest of the "firsts", and back is the "first second" followed by the rest of the "seconds".
unzip has nothing to do with this.
(define (front a)
(if (null? a)
'()
(cons (car (car a)) (front (cdr a)))))
(define (back b)
(if (null? b)
'()
(cons (car (cdr (car b))) (back (cdr b)))))
And now...
> (front test)
'(1 3 5)
> (back test)
'(2 4 6)
> (unzip test)
'((1 3 5) (2 4 6))
So I am trying to write a function that will calculate the root of a binary tree in scheme. The root is calculated by the following criteria: the value at the root is the maximum of the values at its two children, where each of those values is the minimum for its two children, etc. Alternating between maximizing the children and minimizing the children.
so (TREEMAX '((3 (2 5)) (7 (2 1))) would return 3, because 5 is the max of 2 and 5. 3 is the minimum of 3 and 5. 2 is the max of 2 and 1. 2 is the min of 7 and 2. And finally to get root 3 is the max of 3 and 2. The code I have so far is as follows:
(define TREEMAX
(lambda (a)
(cond ((list? (car a)) TREEMIN (car a))
((list? (cdr a)) TREEMIN (cdr a))
((> (car a) (cdr a)) (car a))
(#t (cdr b)))))
(define TREEMIN
(lambda (a)
(cond ((list? (car a)) TREEMAX (car a))
((list? (cdr a)) TREEMAX (cdr a))
((< (car a) (cdr a)) (car a))
(#t (cdr b)))))
But my code is not returning the right number. Where could I be going wrong?
If I understand your description correctly, this should do:
(define (root lst (res null) (maxmin #t))
(if (null? lst)
(apply (if maxmin max min) res)
(let ((c (car lst)))
(root (cdr lst)
(cons (if (list? c) (root c null (not maxmin)) c) res)
maxmin))))
then
> (root '((3 (2 5)) (7 (2 1))))
3
> (root '((3 (2 (1 5))) (7 ((2 7) 1))))
2
> (root '(1 2))
2
To see how it works, here's a version with a debugging printf:
(define (root lst (res null) (maxmin #t))
(if (null? lst)
(let* ((op (if maxmin max min)) (vl (apply op res)))
(printf "~a ~a = ~a\n" op res vl)
vl)
(let ((c (car lst)))
(root (cdr lst)
(cons (if (list? c) (root c null (not maxmin)) c) res)
maxmin))))
which outputs, for your example:
#<procedure:max> (5 2) = 5
#<procedure:min> (5 3) = 3
#<procedure:max> (1 2) = 2
#<procedure:min> (2 7) = 2
#<procedure:max> (2 3) = 3
When you apply the function car you use (car a) but when you apply the function TREEMAX you use TREEMAX (car a)?
The syntax of your code is wrong; you were unlucky that the errors are not flagged as syntax errors. Here is a fix:
(define TREEMAX
(lambda (a)
(cond ((list? (car a)) (TREEMIN (car a)))
((list? (cdr a)) (TREEMIN (cdr a)))
((> (car a) (cdr a)) (car a))
(else (cdr b))))
No idea if this solves your specific problem, but at least you'll be able to trust the computed value.
I have two procedures, one for counting an element in the list and the other one for removing the same element from the same list. What should I do for counting and removing at the same time? I am trying it for long time but nothing is working. I work with this list: (list 1 2 3 2 1 2 3), finally it should be like: ((1 . 2) (2 . 3) (3 . 2)). The first number of pair is an element and second number of pair is sum of first pair's number from all list.
My try:
1) it works only with counting and result is: ((1 . 2) (2 . 3) (3 . 2) (2 . 2) (1 . 1) (2 . 1) (3 . 1))
2) it works only with removing and result is: ((1 . 2) 2 3 2 2 3)
Where is the problem?
This is for counting:
(define count-occurrences
(lambda (x ls)
(cond
[(memq x ls) =>
(lambda (ls)
(+ (count-occurrences x (cdr ls)) 1))]
[else 0])))
(count-occurrences '2 (list 1 2 3 2 1 2 3)) -> 3
This is for removing:
(define (remove-el p s)
(cond ((null? s) '())
((equal? p (car s)) (remove-el p (cdr s)))
(else (cons (car s) (remove-el p (cdr s))))))
(remove-el '2 (list 1 2 3 2 1 2 3)) -> (1 3 1 3)
Just return the count and the removed list at once. I call this routine
count-remove. (Pardon to all schemers for not idiomatic or efficient style)
(define (count-remove ls x)
(letrec ([loop (lambda (count l removed)
(cond
[(eq? l '()) (list count removed)]
[(eq? (car l) x) (loop (+ 1 count) (cdr l) removed)]
[else (loop count (cdr l) (cons (car l) removed))]))])
(loop 0 ls '())))
(define (count-map ls)
(cond
[(eq? ls '()) '()]
[else
(letrec ([elem (car ls)]
[cr (count-remove ls elem)])
(cons (cons elem (car cr)) (count-map (cadr cr))))]))
Here is some usage:
(count-map '(1 1 2 3 2))
((1 . 2) (2 . 2) (3 . 1))
I am trying to add a matrix and it is not working...
(define (matrix-matrix-add a b)
(map (lambda (row) (row-matrix-add row b))
a))
(define (row-matrix-add row matrix)
(if (null? (car matrix))
'()
(cons (add-m row (map car matrix))
(row-matrix-add row (map cdr matrix)))))
(define (add-m row col)
(if (null? col)
0
(+ (car row)
(car col)
(add-m (cdr row) (cdr col)))))
Here is very short working implementation. Map is good at getting rid of a layer of recursion, when you can use it.
(define (matrix-add x y) (map (lambda (x y) (map + x y)) x y))
Here is a working implementation:
(define (matrix-add m1 m2)
(define (matrix-add-row r1 r2 res-row)
(if (and (not (null? r1)) (not (null? r2)))
(matrix-add-row (cdr r1) (cdr r2)
(cons (+ (car r1) (car r2)) res-row))
(reverse res-row)))
(define (matrix-add-each m1 m2 res)
(if (and (not (null? m1)) (not (null? m2)))
(let ((res-row (matrix-add-row (car m1) (car m2) ())))
(matrix-add-each (cdr m1) (cdr m2) (cons res-row res)))
(reverse res)))
(matrix-add-each m1 m2 ()))
Sample usage and output:
> (matrix-add '((7 2) (3 8)) '((4 8) (0 5)))
((11 10) (3 13))
> (matrix-add '((5 2) (4 9) (10 -3)) '((-11 0) (7 1) (-6 -8)))
((-6 2) (11 10) (4 -11))