How do I write all-but-one function in Scheme/LISP?

Question

Can you guys think of the shortest and the most idiomatic solution to all-but-one function?

;; all-but-one
;; checks if all but one element in a list holds a certain property
;; (all-but-one even? (list 1 2 4)) -> true
;; (all-but-one even? '(1)) -> true
;; (all-but-one even? '(2 4)) -> false

Edit: all but EXACTLY one.

Answer 1

If the first element has the specified property, call all-but-one on the remainder of the list.

If the first element does not have the specified property, call all on the remainder of the list.

Answer 2

With a better name:

(define (all-except-one pred l) (= 1 (count (negate pred) l)))

(But this is PLT specific.)

Answer 3

The PLT solution is elegant, and ordinarily I prefer to use built-in higher-order functions as opposed to writing my own recursive functions. But if you want an efficient recursive solution with no allocation and no arithmetic, here it is:

(define (all-but-one pred l)
  (if (null? l) 
     #f
     ((if (pred (car l)) all-but-one all) pred (cdr l))))

The recursive call is in tail position, so both Scheme and Common LISP will compile this code into a tight loop. Some people might prefer this equivalent code:

(define (all-but-one pred l)
  (if (null? l) 
     #f
     (if (pred (car l))
        (all-but-one pred (cdr l))
        (all pred (cdr l)))))

Answer 4

Common Lisp:

(defun all-but-one-p (predicate sequence)
  (= 1 (count-if-not predicate sequence)))

Example:

CL-USER 92 > (all-but-one-p #'evenp '(1 2 3))
NIL

CL-USER 93 > (all-but-one-p #'evenp '(1 2 4))
T

This LOOP-based version quits early if more than one element delivers a negative result for the predicate.

(defun all-but-one-p (predicate list)
  (= 1 (loop with not-pred = (complement predicate)
             for item in list count (funcall not-pred item) into counter
             when (> counter 1) do (return-from all-but-one-p nil)
             finally do (return counter))))

Answer 5

(define (all-but-one p? xs)
  (= (length (filter p? xs)) (- (length xs) 1)))

OK, how about this: not so short, but just one pass over the list. You could do the same sort of thing using a fold.

(define (all-but-one p? xs)
  (let loop ((len 0) (sat 0) (tmp xs))
    (if (null? tmp)
        (= sat (- len 1))
        (loop (+ len 1)
              (if (p? (car tmp)) (+ sat 1) sat)
              (cdr tmp)))))

Answer 6

generalized Anon's idea.

(define (all-but-n n pred lst)
  (if (null? lst)
      (zero? n)
      (if (pred (car lst))
          (all-but-n n pred (cdr lst))
          (if (zero? n)
              #f
              (all-but-n (- n 1) pred (cdr lst))))))

(define (all-but-one pred lst) (all-but-n 1 pred lst))

Answer 7

A solution that should work on all decent Scheme implementations:

(define (all-but-one? pred values)

  (define (count-neg x)
    (if (not (pred x)) 1 0))

  (let loop ((c 0) (values values))
    (if (and (not (null? values))
         (<= c 1))
    (loop (+ c (count-neg (car values))) (cdr values))
    (= c 1))))

Answer 8

(define (all-but-one? p ls)
  (define (all? ls)
    (or (null? ls)
        (and (p    (car ls))
             (all? (cdr ls))))
  (define (loop ls)
    (cond ((null? ls)   #f)
          ((p (car ls)) (all? (cdr ls)))
          (else         (loop (cdr ls)))))
  (loop ls))