What would be the definition of "map" function without using any other high-level functional in Racket?
I need a stack recursion version.
A simple definition of a map function could be:
(define (map f l)
(if (null? l)
'()
(cons (f (car l)) (map f (cdr l)))))
(map (lambda (n) (* n n)) '(1 2 3 4)) ;; => (1 4 9 16)
Usually you'll find map being made with fold, but I prefer doing everything with pair-for-each (maplist in CL). This defines pair-for-each, map, filter-map, filter, zip and unzip compatible with the same procedures in SRFI-1 List library.
#!racket/base
(define-values (pair-for-each map filter-map filter zip unzip)
(let ((%MAP-PASS (list 'MAP-PASS))
(%MAP-END (list 'MAP-END)))
;; pair-for-each-1 applies proc to every cons
;; in order until proc returns %MAP-END
;; when proc evaluates to %MAP-PASS the result is skipped
(define (pair-for-each-1 proc lst (next cdr))
(let loop ((lst lst))
(let ((res (proc lst)))
(cond ((eq? res %MAP-END) '())
((eq? res %MAP-PASS) (loop (next lst)))
(else (cons res
(loop (next lst))))))))
;; Transform a typical map procedure to include
;; a %MAP-END when the list argument is eq? a certain value
(define (stop-at value proc)
(lambda (lst)
(if (eq? value lst)
%MAP-END
(proc lst))))
;; Takes a lists of lists and returns a
;; new list with the cdrs
(define (cdrs lsts)
(pair-for-each-1 (stop-at '() cdar) lsts))
;; Takes a list of lists and returns a
;; new list with the cars except if one of
;; the sublists are nil in which the result is also nil
(define (cars lsts)
(call/cc (lambda (exit)
(pair-for-each-1 (stop-at '()
(lambda (x)
(let ((x (car x)))
(if (null? x)
(exit '())
(car x)))))
lsts))))
;; Takes a list of lists and returns #t if any are null
(define (any-null? lsts)
(if (null? lsts)
#f
(or (null? (car lsts))
(any-null? (cdr lsts)))))
;; Return value definitions starts here
;; pair-for-each is called maplist in CL
(define (pair-for-each proc lst . lsts)
(if (null? lsts)
(pair-for-each-1 (stop-at '() (lambda (x) (proc x))) lst)
(pair-for-each-1 (lambda (args)
(if (any-null? args)
%MAP-END
(apply proc args)))
(cons lst lsts)
cdrs)))
;; Multi arity map
(define (map f lst . lsts)
(if (null? lsts)
(pair-for-each-1 (stop-at '() (lambda (x) (f (car x)))) lst)
(pair-for-each-1 (lambda (x)
(let ((args (cars x)))
(if (null? args)
%MAP-END
(apply f args))))
(cons lst lsts)
cdrs)))
;; filter-map is like map except it skips false values
(define (filter-map proc . lsts)
(apply map (lambda x
(or (apply proc x) %MAP-PASS)))
lsts)
;; filter only takes one list and instead of the result it
;; takes the original argument as value (which may be #f)
(define (filter predicate? lst)
(pair-for-each-1 (stop-at '()
(lambda (x)
(let ((x (car x)))
(if (predicate? x)
x
%MAP-PASS))))
lst))
;; zip (zip '(1 2 3) '(a b c)) ; ==> ((1 a) (2 b) (3 c))
(define (zip lst . lsts)
(apply map list (cons lst lsts)))
;; unzip does the same except it takes a list of lists as argument
(define (unzip lsts)
(apply map list lsts))
;; return procedures
(values pair-for-each map filter-map filter zip unzip)))
It was unclear to me what kind of implementation the OP asked for, so here is yet another variation of map.
; map : function list -> list
; (map f '()) = '()
; (map f (cons x xs)) = (cons (f x) (map f xs))
(define (my-map f xs)
; loop : list list -> list
; (loop (list x1 ... xn) (list y1 ... ym)) = (list (f x1) ... (f xn) ym ... y1)
(define (loop xs ys)
(match xs
['() (reverse ys)]
[(cons x xs) (loop xs (cons (f x) ys))]))
(loop xs '()))
Example:
(my-map sqrt '(1 4 9 16))
'(1 2 3 4)
Related
I'm trying to write function for insertion sort with and without primitive functions.
My code with primitive functions is below.
(define (insert n d)
(cond ((null? n) d)
((null? d) n)
(else (< (car n) (car d)) (cons (car n) (insert (cdr n) d)) (cons (car d) (insert (cdr d) n)))))
(define (sort n)
(cond ((null? n) '())
(else (insert (list (car n)) (sort (cdr n))))))
How should I revise insert and sort to not use car, cdr, and cons?
Edit: I tried to write the insert function. This is what I have so far.
(define (insert n d)
(let ((rest-digit (truncate (/ n 10))))
(if (null? n) 0
(+ rest-digit (insert (- n 1) d)))))
(insert '(3 2 1) '5)
Edit #2: I think I can use the built-in function expt.
Ultimately you will be using primitive functions. To illustrate let me show you a trick that actually uses cons, car, and cdr under the hood:
(define (my-car lst)
(apply (lambda (a . d) a) lst))
(define (my-cdr lst)
(apply (lambda (a . d) d) lst))
(define (my-cons a d)
(apply (lambda l l) a d))
(define test (my-cons 1 '(2 3)))
test ; ==> (1 2 3)
(my-car test) ; ==> 1
(my-cdr test) ; ==> (2 3)
This abuses the fact that apply takes a list as the final arguments and that rest arguments are cons-ed onto a list in order. cons doesn't work for all pairs:
(my-cons 1 2) ; ERROR: expected list?, got 1
You can make cons, car, and cdr such that they adher to the same rules as primitive cons, but that they are not made of pairs at all. Barmar suggested closures:
(define (ccons a d)
(lambda (f) (f a d))
(define (ccar cc)
(cc (lambda (a d) a)))
(define (ccdr cc)
(cc (lambda (a d) d)))
(define test2 (ccons 1 2))
test2 ; ==> #<function...>
(ccar test2) ; ==> 1
(ccdr test2) ; ==> 2
This works since a and d gets closed over in the returned function and that function passes those values and thus the function acts as an object with two attributes. The challenge with this is that you cannot just pass a list since only "lists" made with ccons will work with ccar and ccdr.
A less classical way is to use vectors:
(define vtag (make-vector 0))
(define (vcons a d)
(let ((v (make-vector 3)))
(vector-set! v 0 vtag)
(vector-set! v 1 a)
(vector-set! v 2 d)
v))
(define (vcar vl)
(vector-ref vl 1))
(define (vcdr vl)
(vector-ref vl 2))
(define (vpair? vl)
(eq? vtag (vector-ref vl 0)))
Or you can use records:
(define-record-type :rpair
(rcons a d)
rpair?
(a rcar)
(d rcdr))
(define test (rcons 1 2))
(rpair? test) ; ==> #t
(rcar test) ; ==> 1
(rcdr test) ; ==> 2
Now I think records just syntax sugar and abstractions and that under the hood you are doing exactly the same as the vector version with less code, but that isn't a bad thing.
EDIT
So from the comments if the only restriction is to avoid car, cdr, and cons, but no restrictions on their sisters we might as well implement with them:
(define (sort lst)
(define (insert e lst)
(if (null? lst)
(list e)
(let ((a (first lst)))
(if (>= a e)
(list* e lst)
(list* a (insert e (rest lst)))))))
(foldl insert
'()
lst))
(sort '(1 5 3 8 5 0 2))
; ==> (0 1 2 3 5 5 8)
And of course my first suggestion works in its place:
(define (sort lst)
(define (my-car lst)
(apply (lambda (a . d) a) lst))
(define (my-cdr lst)
(apply (lambda (a . d) d) lst))
(define (my-cons a d)
(apply (lambda l l) a d))
(define (insert e lst)
(if (null? lst)
(my-cons e '())
(let ((a (my-car lst)))
(if (>= a e)
(my-cons e lst)
(my-cons a (insert e (my-cdr lst)))))))
(foldl insert
'()
lst))
And of course, using substitution rules you can make it utterly ridiculous:
(define (sort lst)
;; insert element e into lst in order
(define (insert e lst)
(if (null? lst)
((lambda l l) e)
(let ((a (apply (lambda (a . d) a) lst)))
(if (>= a e)
(apply (lambda l l) e lst)
(apply (lambda l l)
a
(insert e (apply (lambda (a . d) d) lst)))))))
;; main loop of sort
;; insert every element into acc
(let loop ((lst lst) (acc '()))
(if (null? lst)
acc
(loop (apply (lambda (a . d) d) lst)
(insert (apply (lambda (a . d) a) lst)
acc)))))
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
How would I loop this list in scheme?
(define test-document '(
((h e l l o))
((t h i s)(i s)(t e s t))
))
What I tried it only showed the first column.
car and cdr family of functions are your friends to navigate lists. Here are some examples.
(define test-document '(
((h e l l o))
((t h i s)(i s)(t e s t))
))
(car test-document) ;; `((h e l l o))
(caar test-document) ;; `(h e l l o)
(cadr test-document) ;; `((t h i s) (i s) (t e s t))
(car (cadr test-document) ;; `(t h i s)
(cadr (cadr test-document) ;; `(i s)
(caddr (cadr test-document) ;; `(test )
Define a function that will walk the list and call a function for each item that is not a list.
(define (walk-list lst fun)
(if (not (list? lst))
(fun lst)
(if (not (null? lst))
(begin
(walk-list (car lst) fun)
(walk-list (cdr lst) fun)))))
Call it to print each item.
(walk-list test-document print)
What you have is a list of lists of lists:
(define test-document '(((h e l l o)) ((t h i s) (i s) (t e s t))))
To loop over its elements you must create a loop of a loop of a loop. To do so we can use map and curry as follows:
(map (curry map (curry map
(compose string->symbol string-upcase symbol->string)))
test-document)
This produces the following output:
(((H E L L O)) ((T H I S) (I S) (T E S T)))
If your Scheme interpreter doesn't have a built-in curry function then you can define one as follows:
(define (curry func . args)
(lambda x (apply func (append args x))))
Hope this helped.
Were you thinking of something like this?
(define (walk-list lst)
(define (sub-walk lst)
(if (null? lst)
'()
(let ((x (car lst)))
(if (list? x)
(cons (sub-walk x) (sub-walk (cdr lst)))
(apply string-append (map symbol->string lst))))))
(flatten (sub-walk lst)))
then
(walk-list test-document)
=> '("hello" "this" "is" "test")
which you can process using the usual suspects (map, filter, ...).
If your Scheme has no flatten procedure, you can use this one:
(define (flatten lst)
(reverse
(let loop ((lst lst) (res null))
(if (null? lst)
res
(let ((c (car lst)))
(loop (cdr lst) (if (pair? c) (loop c res) (cons c res))))))))
In an application I'm working on in Racket I need to take a list of numbers and partition the list into sub-lists of consecutive numbers:
(In the actual application, I'll actually be partitioning pairs consisting of a number and some data, but the principle is the same.)
i.e. if my procedure is called chunkify then:
(chunkify '(1 2 3 5 6 7 9 10 11)) -> '((1 2 3) (5 6 7) (9 10 11))
(chunkify '(1 2 3)) -> '((1 2 3))
(chunkify '(1 3 4 5 7 9 10 11 13)) -> '((1) (3 4 5) (7) (9 10 11) (13))
(chunkify '(1)) -> '((1))
(chunkify '()) -> '(())
etc.
I've come up with the following in Racket:
#lang racket
(define (chunkify lst)
(call-with-values
(lambda ()
(for/fold ([chunk '()] [tail '()]) ([cell (reverse lst)])
(cond
[(empty? chunk) (values (cons cell chunk) tail)]
[(equal? (add1 cell) (first chunk)) (values (cons cell chunk) tail)]
[else (values (list cell) (cons chunk tail))])))
cons))
This works just fine, but I'm wondering given the expressiveness of Racket if there isn't a more straightforward simpler way of doing this, some way to get rid of the "call-with-values" and the need to reverse the list in the procedure etc., perhaps some way comepletely different.
My first attempt was based very loosely on a pattern with a collector in "The Little Schemer" and that was even less straightforward than the above:
(define (chunkify-list lst)
(define (lambda-to-chunkify-list chunk) (list chunk))
(let chunkify1 ([list-of-chunks '()]
[lst lst]
[collector lambda-to-chunkify-list])
(cond
[(empty? (rest lst)) (append list-of-chunks (collector (list (first lst))))]
[(equal? (add1 (first lst)) (second lst))
(chunkify1 list-of-chunks (rest lst)
(lambda (chunk) (collector (cons (first lst) chunk))))]
[else
(chunkify1 (append list-of-chunks
(collector (list (first lst)))) (rest lst) list)])))
What I'm looking for is something simple, concise and straightforward.
Here's how I'd do it:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else (chunkify/chunk (cdr lst) (list (car lst)))]))
;; chunkify/chunk : (listof number) (non-empty-listof number)
;; -> (listof (non-empty-listof number)
;; Continues chunkifying a list, given a partial chunk.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (chunkify/chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(chunkify/chunk (cdr lst)
(cons (car lst) rchunk))]
[else (cons (reverse rchunk) (chunkify lst))]))
It disagrees with your final test case, though:
(chunkify '()) -> '() ;; not '(()), as you have
I consider my answer more natural; if you really want the answer to be '(()), then I'd rename chunkify and write a wrapper that handles the empty case specially.
If you prefer to avoid the mutual recursion, you could make the auxiliary function return the leftover list as a second value instead of calling chunkify on it, like so:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else
(let-values ([(chunk tail) (get-chunk (cdr lst) (list (car lst)))])
(cons chunk (chunkify tail)))]))
;; get-chunk : (listof number) (non-empty-listof number)
;; -> (values (non-empty-listof number) (listof number))
;; Consumes a single chunk, returns chunk and unused tail.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (get-chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(get-chunk (cdr lst)
(cons (car lst) rchunk))]
[else (values (reverse rchunk) lst)]))
I can think of a simple, straightforward solution using a single procedure with only primitive list operations and tail recursion (no values, let-values, call-with-values) - and it's pretty efficient. It works with all of your test cases, at the cost of adding a couple of if expressions during initialization for handling the empty list case. It's up to you to decide if this is concise:
(define (chunkify lst)
(let ((lst (reverse lst))) ; it's easier if we reverse the input list first
(let loop ((lst (if (null? lst) '() (cdr lst))) ; list to chunkify
(cur (if (null? lst) '() (list (car lst)))) ; current sub-list
(acc '())) ; accumulated answer
(cond ((null? lst) ; is the input list empty?
(cons cur acc))
((= (add1 (car lst)) (car cur)) ; is this a consecutive number?
(loop (cdr lst) (cons (car lst) cur) acc))
(else ; time to create a new sub-list
(loop (cdr lst) (list (car lst)) (cons cur acc)))))))
Yet another way to do it.
#lang racket
(define (split-between pred xs)
(let loop ([xs xs]
[ys '()]
[xss '()])
(match xs
[(list) (reverse (cons (reverse ys) xss))]
[(list x) (reverse (cons (reverse (cons x ys)) xss))]
[(list x1 x2 more ...) (if (pred x1 x2)
(loop more (list x2) (cons (reverse (cons x1 ys)) xss))
(loop (cons x2 more) (cons x1 ys) xss))])))
(define (consecutive? x y)
(= (+ x 1) y))
(define (group-consecutives xs)
(split-between (λ (x y) (not (consecutive? x y)))
xs))
(group-consecutives '(1 2 3 5 6 7 9 10 11))
(group-consecutives '(1 2 3))
(group-consecutives '(1 3 4 5 7 9 10 11 13))
(group-consecutives '(1))
(group-consecutives '())
I want to play.
At the core this isn't really anything that's much different from what's
been offered but it does put it in terms of the for/fold loop. I've
grown to like the for loops as I think they make for much
more "viewable" (not necessarily readable) code. However, (IMO --
oops) during the early stages of getting comfortable with
racket/scheme I think it's best to stick to recursive expressions.
(define (chunkify lst)
(define-syntax-rule (consecutive? n chunk)
(= (add1 (car chunk)) n))
(if (null? lst)
'special-case:no-chunks
(reverse
(map reverse
(for/fold ([store `((,(car lst)))])
([n (cdr lst)])
(let*([chunk (car store)])
(cond
[(consecutive? n chunk)
(cons (cons n chunk) (cdr store))]
[else
(cons (list n) (cons chunk (cdr store)))])))))))
(for-each
(ƛ (lst)
(printf "input : ~s~n" lst)
(printf "output : ~s~n~n" (chunkify lst)))
'((1 2 3 5 6 7 9 10 11)
(1 2 3)
(1 3 4 5 7 9 10 11 13)
(1)
()))
Here's my version:
(define (chunkify lst)
(let loop ([lst lst] [last #f] [resint '()] [resall '()])
(if (empty? lst)
(append resall (list (reverse resint)))
(begin
(let ([ca (car lst)] [cd (cdr lst)])
(if (or (not last) (= last (sub1 ca)))
(loop cd ca (cons ca resint) resall)
(loop cd ca (list ca) (append resall (list (reverse resint))))))))))
It also works for the last test case.
(define filter-in
(lambda (predicate list)
(let((f
(lambda (l)
(filter-in-sexpr predicate l))))
(map f list))))
(define filter-in-aux
(lambda (pred lst)
(if (null? lst) '()
(cons (filter-in-sexpr pred (car lst))
(filter-in-aux pred (cdr lst))))))
(define filter-in-sexpr
(lambda (pred sexpr)
(if (equal? (pred sexpr) #t)
sexpr
'())))
Calling (filter-in number? ’(a 2 (1 3) b 7)) produces ( () 2 () () 7).
How I can skip null elements from the generated list to get final outcome of (2 7) ?
The problem is that you're mapping filter-in-sxpr over the list. You can either run another filter pass to remove the nulls, or use a modified filter-in-aux like this:
(define filter-in-aux
(lambda (pred lst)
(if (null? lst) '()
(let ((h (filter-in-sexpr pred (car lst)))
(t (filter-in-aux pred (cdr lst))))
(if (null? h) t
(cons h t))))))