What is definition of “map” in Racket

Question

What would be the definition of "map" function without using any other high-level functional in Racket?

I need a stack recursion version.

Answer 1

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)

Answer 2

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