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))
Related
I'm looking to write a procedure that will take a list in the form '(0 7 10 14) and transform it into a list '((0 . 7) (7 . 10) (10 . 14)). The procedure below will do exactly that. I think it's rather messy and can't find a simpler way to write it. Maybe I can use a built-in racket function to do this?
(define (simplify-path path)
(if (null? (cddr path))
(cons (cons (car path) (cadr path)) '())
(begin (cons (cons (car path) (cadr path))
(simplify-path (cdr path))))))
Using Racket, we can do this:
(define (simplify-path path)
(map cons
(drop-right path 1)
(rest path)))
It works as expected:
(simplify-path '(0 7 10 14))
=> '((0 . 7) (7 . 10) (10 . 14))
(define (simplify-path path)
(for/list ([x path] [y (cdr path)]) (cons x y)))
Does it too.
In contrast to map, for/list can take two different length lists - cuts down to length of shortest.
written in mit-scheme.
(define list->assocs
(lambda (l)
(define pair-first-second
(lambda (l)
(cons (car l) (cadr l))))
(define iter
(lambda (l k)
(if (eq? '() (cddr l))
(k (pair-first-second l))
(iter (cdr l)
(lambda (r)
(k (cons (pair-first-second l) r)))))))
(if (or (eq? '() l)
(eq? '() (cdr l)))
l
(iter l
(lambda (x) x)))))
(list->assocs '(0 7 10 14))
(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))
I'm trying to use direct recursion to sort a list into a list of sublists of even and odd positions.
So (split '(1 2 3 4 5 6)) returns ((1 3 5) (2 4 6))
and (split '(a 2 b 3)) returns ((a b) (2 3))
So far, I have the following code:
(define split
(lambda (ls)
(if (or (null? ls) (null? (cdr ls)))
(values ls '())
(call-with-values
(lambda () (split (cddr ls)))
(lambda (odds evens)
(values (cons (car ls) odds)
(cons (cadr ls) evens)))))))
However, now I'm stumped on how to store multiple outputs into a single list.
I know that calling it like this:
(call-with-values (lambda () (split '(a b c d e f))) list)
returns a list of sublists, however I would like the function itself to return a list of sublists. Is there a better way to do this that doesn't involve the use of values and call-with-values?
Sure. Here's an adapted version of your code:
(define (split ls)
(if (or (null? ls) (null? (cdr ls)))
(list ls '())
(let ((next (split (cddr ls))))
(list (cons (car ls) (car next))
(cons (cadr ls) (cadr next))))))
One thing that I like about the code in the question is that it uses odds and evens in a way that reflects the specification.
The objectives of this solution are:
Readability.
To reflect the language of the specification in the code.
To use O(n) space during execution.
It uses an internal function with accumulators and a trampoline.
#lang racket
;; List(Any) -> List(List(Any) List(Any))
(define (split list-of-x)
(define end-of-list (length list-of-x))
;; List(Any) List(Any) List(Any) Integer -> List(List(Any) List(Any))
(define (looper working-list odds evens index)
(cond [(> index end-of-list)
(list (reverse odds)
(reverse evens))]
[(odd? index)
(looper (rest working-list)
(cons (car working-list) odds)
evens
(add1 index))]
[(even? index)
(looper (rest working-list)
odds
(cons (car working-list) evens)
(add1 index))]
[else
(error "split: unhandled index condition")]))
(looper list-of-x null null 1))
Here's an answer that should be clear if you are familiar with match syntax. It is identical in form and function to Chris Jester-Young's answer, but uses match to clarify list manipulation.
#lang racket
(define (split ls)
(match ls
[`(,first ,second ,rest ...)
(match (split rest)
[`(,evens ,odds) (list (cons first evens)
(cons second odds))])]
[_ (list ls '())]))
(: split ((list-of natural) -> (list-of (list-of natural))))
(define split
(lambda (xs)
(list (filter even? xs) (filter odd? xs))))
(: filter ((%a -> boolean) (list-of %a) -> (list-of %a)))
(define filter
(lambda (p xs)
(fold empty (lambda (first result)
(if (p first)
(make-pair first result)
result)) xs)))
(check-expect (split (list 1 2 3 4 5 6)) (list (list 2 4 6) (list 1 3 5)))
i think this one is also really easy to understand..
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)))
I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2