Matrix addition in Scheme - matrix

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))

Related

Why is my scheme program not combining my two list correctly at the end?

(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))

(Scheme) How do I add 2 lists together that are different sizes

I'm completely new to scheme and I'm having trouble trying to add 2 lists of different sizes. I was wondering how do I add 2 lists of different sizes together correctly. In my code I compared the values and append '(0) to the shorter list so that they can get equal sizes, but even after doing that I can not use map to add the 2 lists. I get an error code after running the program. The results I should be getting is '(2 4 5 4). Could anyone help me out? Thanks.
#lang racket
(define (add lst1 lst2)
(cond [(< (length lst1) (length lst2)) (cons (append lst1 '(0)))]
[else lst1])
(cond
((and (null? lst1)(null? lst2)) null)
(else
(map + lst1 lst2))))
;;Result should be '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
ERROR:
cons: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
'(1 2 3 0)
The problem with your code is that there are two cond expressions one after the other - both will execute, but only the result of the second one will be returned - in other words, the code is not doing what you think it's doing. Now, to solve this problem it'll be easier if we split the solution in two parts (in general, that's a good strategy!). Try this:
(define (fill-zeroes lst n)
(append lst (make-list (abs n) 0)))
(define (add lst1 lst2)
(let ((diff (- (length lst1) (length lst2))))
(cond [(< diff 0)
(map + (fill-zeroes lst1 diff) lst2)]
[(> diff 0)
(map + lst1 (fill-zeroes lst2 diff))]
[else (map + lst1 lst2)])))
Explanation:
The fill-zeroes procedure takes care of filling the tail of a list with a given number of zeroes
The add procedure is in charge of determining which list needs to be filled, and when both lists have the right size performs the actual addition
It works as expected for any combination of list lengths:
(add '(1 2 3 4) '(1 2 3))
=> '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
=> '(2 4 6 4)
(add '(1 2 3 0) '(1 2 3 4))
=> '(2 4 6 4)
Similar to Oscar's, slighty shorter:
(define (fill0 lst len)
(append lst (make-list (- len (length lst)) 0)))
(define (add lst1 lst2)
(let ((maxlen (max (length lst1) (length lst2))))
(map + (fill0 lst1 maxlen) (fill0 lst2 maxlen))))
or, for fun, the other way round:
(define (add lst1 lst2)
(let ((minlen (min (length lst1) (length lst2))))
(append
(map + (take lst1 minlen) (take lst2 minlen))
(drop lst1 minlen)
(drop lst2 minlen))))
There's no need to pre-compute the lengths of the lists and add zeroes to the end of one or the other of the lists. Here we solve the problem with a simple recursion:
(define (add xs ys)
(cond ((and (pair? xs) (pair? ys))
(cons (+ (car xs) (car ys)) (add (cdr xs) (cdr ys))))
((pair? xs) (cons (car xs) (add (cdr xs) ys)))
((pair? ys) (cons (car ys) (add xs (cdr ys))))
(else '())))
That works for all of Oscar's tests:
> (add '(1 2 3 4) '(1 2 3))
(2 4 6 4)
> (add '(1 2 3) '(1 2 3 4))
(2 4 6 4)
> (add '(1 2 3 0) '(1 2 3 4))
(2 4 6 4)
If you like, you can write that using a named-let and get the same results:
(define (add xs ys)
(let loop ((xs xs) (ys ys) (zs '()))
(cond ((and (pair? xs) (pair? ys))
(loop (cdr xs) (cdr ys) (cons (+ (car xs) (car ys)) zs)))
((pair? xs) (loop (cdr xs) ys (cons (car xs) zs)))
((pair? ys) (loop xs (cdr ys) (cons (car ys) zs)))
(else (reverse zs)))))
Have fun!
A yet simpler version.
(define (add x y)
(cond ((and (pair? x) (pair? y))
(cons (+ (car x) (car y))
(add (cdr x) (cdr y))))
((pair? x) x)
(else y)))

scheme calculate root of binary tree

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.

Product as input arguments?

In lisp/scheme, is there any form using set product as function input? map form uses n length-equal lists for a function which needs n arguments. Sometimes, we need the arguments to come from the product of a group of sets. For example:
(pmap (λ (d p) foo)
A B)
Here, list A may have different length with B, and pmap feeds each element of the product of A and B to the lambda expression.
Form for* of scheme/racket can do this job:
(for* ([x '(0 2 4)]
[y '(1 3 5)])
((λ (d p)
(printf "(~a, ~a)\n" d p))
x y))
Output:
(0, 1)
(0, 3)
(0, 5)
(2, 1)
(2, 3)
(2, 5)
(4, 1)
(4, 3)
(4, 5)
I want to know whether there exists other means similar to map or fold to do this in scheme.
As far as I know such a thing is not present in the standard. It is however not a problem to write one.
For an overview over useful list functions, I can recommend srfi1, which gives you quite a few useful operations besides map and fold.
http://srfi.schemers.org/srfi-1/srfi-1.html
I wrote the following implementation of pmap. It works using only cons, car, cdr, null?, apply, map and reverse and supports any number of arguments like map does.
(define (pmap f . xs)
(define (carry a xs ys then)
(if (and (not (null? ys)) (null? (car ys)))
'()
(if (null? xs)
(then (reverse a))
(if (null? (car xs))
(if (null? (cdr xs))
'()
(carry (cons (car ys) a) (cons (cdr (car (cdr xs))) (cdr (cdr xs))) (cdr ys) then))
(carry (cons (car xs) a) (cdr xs) (cdr ys) then)))))
(define (pmap-helper f xs ys)
(carry '() xs ys
(lambda (xs)
(cons (apply f (map car xs))
(pmap-helper f (cons (cdr (car xs)) (cdr xs)) ys)))))
(pmap-helper f xs xs))
(display (pmap list '(0 2 4) '(1 3 5))) (newline)
;((0 1) (2 1) (4 1) (0 3) (2 3) (4 3) (0 5) (2 5) (4 5))
The only difference is that the earlier lists are iterated over faster than later ones where as your example is the reverse. This pmap can be modified to do that:
(define (pmap f . xs)
(define (carry a xs ys then)
(if (and (not (null? ys)) (null? (car ys)))
'()
(if (null? xs)
(then (reverse a))
(if (null? (car xs))
(if (null? (cdr xs))
'()
(carry (cons (car ys) a) (cons (cdr (car (cdr xs))) (cdr (cdr xs))) (cdr ys) then))
(carry (cons (car xs) a) (cdr xs) (cdr ys) then)))))
(define (pmap-helper f xs ys)
(carry '() xs ys
(lambda (xs)
(cons (apply f (reverse (map car xs)))
(pmap-helper f (cons (cdr (car xs)) (cdr xs)) ys)))))
(let ((xs (reverse xs)))
(pmap-helper f xs xs)))
(display (pmap list '(0 2 4) '(1 3 5))) (newline)
; ((0 1) (0 3) (0 5) (2 1) (2 3) (2 5) (4 1) (4 3) (4 5))

Encapsulating Certain Parts of List

I'm trying to write a procedure that "encapsulates" (i.e. puts in a list) elements of a list between a "separator" element.
(my-proc '(1 + 2))
=> ((1) (2))
(my-proc '(x * y + z ^ 2 + 1 + 5))
=> ((x * y) (z ^ 2) (1) (5))
(my-proc '((x + 1) * y + 5))
=> (((x + 1) * y) (5))
In this case the procedure can be hard-coded to define the + symbol as the separator.
Assume that foldr (fold right operation) is defined, I'd prefer that it'd be in terms of it.
I'm not giving a full solution since this looks really homework-y.
(define (split-expr expr)
(foldr (lambda (e es)
(if (eq? e '+)
<???> ; do split
(cons (cons e (car es))
(cdr es))))
<???> ; what should start be?
es))
Just for fun, here's a version in continuation-passing style (no foldr, probably not suitable as a homework answer):
(define split/cps
(λ (sep ls)
(let loop ([ls ls] [k (λ (item acc)
(if item (cons item acc) acc))])
(cond
[(null? ls)
(k #f '())]
[(eq? sep (car ls))
(loop (cdr ls)
(λ (item acc)
(k #f (if item (cons item acc) acc))))]
[else
(loop (cdr ls)
(λ (item acc)
(k (if item
(cons (car ls) item)
(list (car ls)))
acc)))]))))
Here's another way to do it, also without foldr:
(define split/values
(λ (sep ls)
(let loop ([ls ls])
(cond
[(null? ls)
'()]
[else
(let-values ([(a d) (car-to-sep sep ls)])
(if (null? a)
(loop d)
(cons a (loop d))))]))))
(define car-to-sep
(λ (sep ls)
(let loop ([ls ls] [a '()])
(cond
[(null? ls)
(values '() '())]
[(eq? sep (car ls))
(values '() (cdr ls))]
[else
(let-values ([(a d) (loop (cdr ls) a)])
(values (cons (car ls) a) d))]))))

Resources