Here's a function that makes my day!
(I didn't set out to break every rule of hypermodern programming,
but I came close anyway (I forgot to include a goto)):
(define (log-n-of n . ints) ; bits on in exactly n of ints
(define (log-none-of . ints) ; bits on in none of ints
(lognot (apply logior ints)))
(define (log-all-of . ints) ; bits on in all of ints
(apply logand ints))
(define (log-1-of . ints) ; bits on in exactly 1 of ints
(let ((len (length ints)))
(cond ((= len 0)
0)
((= len 1)
(car ints))
((= len 2)
(apply logxor ints))
((= len 3)
(logxor (apply logxor ints) (apply logand ints)))
(#t
(do ((iors '())
(i 0 (+ i 1)))
((= i len) (apply logior iors))
(let ((cur (ints i)))
(set! (ints i) 0)
(set! iors (cons (logand cur (lognot (apply logior ints)))
iors))
(set! (ints i) cur)))))))
(define (log-n-1-of . ints) ; bits on in exactly n-1 of ints
(let ((len (length ints)))
(cond ((= len 0)
0)
((= len 1)
0)
((= len 2)
(apply logxor ints))
((= len 3)
(logand (lognot (apply logxor ints)) (apply logior ints)))
(#t
(do ((iors '())
(i 0 (+ i 1)))
((= i len) (apply logior iors))
(let ((cur (ints i)))
(set! (ints i) -1)
(set! iors (cons (logand (lognot cur) (apply logand ints))
iors))
(set! (ints i) cur)))))))
(let ((len (length ints)))
(cond ((= len 0)
(if (= n 0) -1 0))
((= n 0)
(apply log-none-of ints))
((= n len)
(apply log-all-of ints))
((> n len)
0)
((= n 1)
(apply log-1-of ints))
((= n (- len 1))
(apply log-n-1-of ints))
;; now n is between 2 and len-2, and len is 3 or more
;; I think it would be less inefficient here to choose either this
;; or the n-1 case based on n <= len/2
(#t
(do ((1s '())
(prev ints)
(i 0 (+ i 1)))
((= i len) (apply logior 1s))
(let ((cur (ints i)))
(if (= i 0)
(set! 1s (cons (logand cur (apply log-n-of (- n 1) (cdr
ints))) 1s))
(let* ((mid (cdr prev))
(nxt (if (= i (- len 1)) '() (cdr mid))))
(set! (cdr prev) nxt)
(set! 1s (cons (logand cur (apply log-n-of (- n 1) ints))
1s))
(set! (cdr prev) mid)
(set! prev mid)))))))))
_______________________________________________
Cmdist mailing list
[email protected]
http://ccrma-mail.stanford.edu/mailman/listinfo/cmdist
