Re: Attribute String...

Subject: Re: Attribute String...
From: James Clark <jjc@xxxxxxxxxx>
Date: Sun, 05 Oct 1997 10:21:50 +0700
Lassi A. Tuura wrote:

> I think I have already sent an implementation of `map' to you in my
> DocBook style-sheet enhancements.  In case you have missed it, here
> comes.  It would of course be best if the tools included it since it is
> part of the DSSSL spec, but at least jade seemed to lack `map' and `cXr'
> family at some point.
> 
> (define (mapfun proc result list other)
>   (if (and (null? list) (null? other))
>       result
>       (if (null? list)
>           (mapfun proc result (car other) (cdr other))
>           (mapfun proc
>                   (cons (proc (car list)) result)
>                   (cdr list)
>                   other))))
> (define (map proc list #!rest other)
>   (reverse (mapfun proc '() list other)))

That implementation is not correct.

  (map + '(1 2 3) '(4 5 6)) 

should return

  (5 7 9)

not

 (1 2 3 4 5 6)

as yours does.

I haven't tested this much:

; (transpose '((a b) (c d) (e f))) => ((a c e) (b d f))

(define (transpose lists)
  (let outer ((result '())
	      (lists lists))
    (if (null? (car lists))
	(reverse result)
	(let inner ((newlist '())
		    (newlists '())
		    (todo lists))
	  (if (null? todo)
	      (outer (cons (reverse newlist) result)
		     (reverse newlists))
	      (let ((tem (car todo)))
		(inner (cons (car tem) newlist)
		       (cons (cdr tem) newlists)
		       (cdr todo))))))))

(define (map proc list #!rest lists)
  (if (null? lists)			; avoid transposition in simple case
      (let loop ((list list)
		 (result '()))
	(if (null? list)
	    (reverse result)
	    (loop (cdr list)
		  (cons (proc (car list))
			result))))
      (let loop ((list (transpose (cons list lists)))
		 (result '()))
	(if (null? list)
	    (reverse result)
	    (loop (cdr list)
		  (cons (apply proc (car list))
			result))))))



 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist


Current Thread