A pmap function in Racket (Scheme)

my-pmap.rkt

#lang racket/base
(require racket/list
         racket/future
         future-visualizer
         future-visualizer/trace)

; Objective: Building an equivalent to Clojure's PMAP .

; PMAP is a lot like MAP. As a first step, let's build our own MAP .

; Let's assume we want to use MAP like this:

(printf "Sample MAP usage:           ")
(map + '(1 2 3) '(4 5 6) '(7 8 9) '(10 11 12))

; Running that yields: '(22 26 30) (I hand checked, it's correct).

; I don't know how MAP is defined, but presumably to take a variable number
; of arguments its LAMBDA header looks something like this:
; (lambda map (f . args) ...
; i.e. it actually takes 2 arguments, namely f and a list of the other args.

; Here's a list for testing with:

(define test-list '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))

(printf "test-list:                  ")
test-list

; Here's how to run MAP with this list as arguments:

(printf "(apply map + test-list):    ")
(apply map + test-list)

; Using MAP to apply "+" to this list, taken as arguments, would mean
; computing ((+ 1 4 7 10) (+ 2 5 8 11) (+ 3 6 12))

; Clearly, this would be a lot easier if this data structure were transposed,
; i.e. if TEST-LIST was a matrix we'd like to have rows and columns swapped.
; Then we'd just need to prepend the function to each sublist and we could
; execute all sublists to obtain our result.

; Given a "matrix" of M rows by N columns, TRANSPOSE starts off by using
; MAKE-LIST in the "starting value" expression of FOLDR to create a list
; containing N empty lists (= NULL). It then calls an anonymous (internal
; LAMBDA) function that uses FOR/LIST to isolate, pair-wise, corresponding
; pairs of simple list values from the accumulator list (ACC) and from the
; current row of LSTS, passed in as ROWS, and to CONS the items from the row
; (in E) onto the corresponding row in the accumulator (in A). FOLDR starts at
; the end of the input list, so for my test data, after its first iteration, the
; accumulator contains '((10) (11) (12)). Next round, it prepends the contents
; of row 3, making ACC '((7 10) (8 11) (9 12)) .

(define transpose
  (lambda (lsts)
    (foldr
     (lambda (acc rows)
       (for/list ([a acc][e rows]) (cons a e)))
     (make-list (length (car lsts)) null)
     lsts)))

(printf "(transpose test-list):      ")
(transpose test-list)

; As Andreas Per Olsson has pointed out to me, TRANSPOSE is trivial if you have
; MAP already:

(define apo-transpose
  (lambda (lsts)
    (map list lsts)))

(printf "(apo-transpose test-list):  ")
(transpose test-list)

; We can use APPLY to prepend the function and FOR/LIST to do that with each
; sub-list. So here's MY-MAP:

(define my-map
  (lambda (f . lists)
    (for/list ([one (transpose lists)])
      (apply f one))))

(printf "(my-map * '(2 3) '(5 7)):   ")
(my-map * '(2 3) '(5 7))

(printf "(apply my-map + test-list:  ")
(apply my-map + test-list)

; Given this fairly simple definition of MY-MAP, it's pretty easy to build
; a list of FUTUREs instead, and TOUCH the resulting list:

(define my-pmap
  (lambda (f . lists)
    (map touch
         (for/list ([one (transpose lists)])
           (future (lambda ()
                     (apply f one)))))))

; MY-PMAP yields the same result as MY-MAP, as it should:

(printf "(apply my-pmap + test-list: ")
(apply my-pmap + test-list)

; To show that MY-PMAP is actually parallelizing, let's make a slow operation.
; (It's a good thing Racket doesn't optimize this useless loop away!)

(define slow-job
  (lambda (how-slow)
    (do ([j 0 (add1 j)])
      ((> j how-slow) #f))))
        
(define slow-plus
  (lambda lists
    (slow-job 10000000)
    (apply + lists)))

; here's a function to time a thunk's execution.
; If VF is true, visualize it too.

(define my-time
  (lambda (thunk vf)
    (begin
      (and vf (start-future-tracing!))
      (let ([t0 (current-inexact-milliseconds)]
            [result (thunk)]
            [t1 (current-inexact-milliseconds)])
        (and vf (begin
                  (stop-future-tracing!)
                  (show-visualizer)))
        (printf "time: ~a ms.~n" (round (- t1 t0)))
        result))))
          
; Run it using MY-MAP:

(printf "~napply my-map slow-plus test-list:  ")
(my-time (lambda ()
           (apply my-map slow-plus test-list))
         #f)

; MY-PMAP yields the same result as MY-MAP, as it should:

(printf "~napply my-pmap slow-plus test-list: ")
(my-time (lambda ()
           (apply my-pmap slow-plus test-list))
         #t)

Results:

Sample MAP usage:           '(22 26 30)
test-list:                  '((1 2 3) (4 5 6) (7 8 9) (10 11 12))
(apply map + test-list):    '(22 26 30)
(transpose test-list):      '((1 4 7 10) (2 5 8 11) (3 6 9 12))
(apo-transpose test-list):  '((1 4 7 10) (2 5 8 11) (3 6 9 12))
(my-map * '(2 3) '(5 7)):   '(10 21)
(apply my-map + test-list:  '(22 26 30)
(apply my-pmap + test-list: '(22 26 30)

apply my-map slow-plus test-list:  time: 512.0 ms.
'(22 26 30)

apply my-pmap slow-plus test-list: time: 181.0 ms.
'(22 26 30)```