コード

Gaucheで総当たりで解きます。わかりやすく書くとこんなコード。

(use srfi-1)
(use util.combinations)

(define (same-answer? x y)
   ;;ネックレスの等価判定。
  (or (equal? x y)
      (equal? x (cons (car x) (reverse (cdr y))))))

(define (5balls-very-simple)
  (define result '())
  (define nums (iota 21 1))
  (combinations-for-each
   (lambda (x)
     (permutations-for-each
      (lambda (x)
	(receive (a b c d e) (apply values x)
	  (when (and (= 21 (+ a b c d e))
		     (lset= eq?
			    nums
			    (list (+ a b c d e)
				  a
				  (+ a b)
				  (+ a b c)
				  (+ a b c d)
				  b
				  (+ b c)
				  (+ b c d)
				  (+ b c d e)
				  c
				  (+ c d)
				  (+ c d e)
				  (+ c d e a)
				  d
				  (+ d e)
				  (+ d e a)
				  (+ d e a b)
				  e
				  (+ e a)
				  (+ e a b)
				  (+ e a b c))))
	    (push! result x))))
      x))
   nums 5)
  (delete-duplicates result same-answer?))

Gaucheのutil.combinationsが総当たりに便利です。で、マクロを使うともっと短くかける部分があるわけで。

(define-macro (math-goodbye . l)
  (let ((cp-list (cartesian-product (list (iota (length l)) (cdr (iota (length l))))))
	(necklace (apply circular-list l)))
    `(list ,@(cons `(+ ,@l)
		   (map (lambda (x)
			  `(+ ,@(take (drop necklace (car x)) (cadr x))))
			cp-list)))))

define (5balls)
  (define result '())
  (define nums (iota 21 1))
  (combinations-for-each
   (lambda (x)
     (permutations-for-each
      (lambda (x)
	(receive (a b c d e) (apply values (cons 1 x))
	  (when (and (= 21 (+ a b c d e))
		     (lset= eq? nums (math-goodbye a b c d e)))
	    (push! result (list a b c d e)))))
      (cons 2 x)))
   '(3 4 5 6 7 8 9 10 11) 3)
  (delete-duplicates result same-answer?))

(define (6balls)
  (define result '())
  (define nums (iota 31 1))
  (combinations-for-each
   (lambda (x)
     (permutations-for-each
      (lambda (x)
	(receive (a b c d e f) (apply values (cons 1 x))
	  (when (and (= 31 (+ a b c d e f))
		     (lset= eq? nums (math-goodbye a b c d e f)))
	    (push! result (list a b c d e f)))))
      (cons 2 x)))
   '(3 4 5 6 7 8 9 10 11 12 13 14 15 16) 4)
  (delete-duplicates result same-answer?))

(define (7balls)
  (define result '())
  (define nums (iota 43 1))
  (combinations-for-each
   (lambda (x)
     (permutations-for-each
      (lambda (x)
	(receive (a b c d e f g) (apply values (cons 1 x))
	  (when (and (= 43 (+ a b c d e f g))
		     (lset= eq? nums (math-goodbye a b c d e f g)))
	    (push! result (list a b c d e f g)))))
      (cons 2 x)))
   '(3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22) 5)
  (delete-duplicates result same-answer?))

ここまで来たら、8balls, 9balls ... を自動生成するマクロを書いてやるぜ。満足満足。

(use srfi-1)
(use util.combinations)

(define (same-answer? x y)
   ;;ネックレスの等価判定。
  (or (equal? x y)
      (equal? x (cons (car x) (reverse (cdr y))))))

(define-macro (math-goodbye . l)
  (let ((cp-list (cartesian-product (list (iota (length l)) (cdr (iota (length l))))))
	(necklace (apply circular-list l)))
    `(list ,@(cons `(+ ,@l)
		   (map (lambda (x)
			  `(+ ,@(take (drop necklace (car x)) (cadr x))))
			cp-list)))))

(define-syntax nballs-helper
  (syntax-rules ()
    ((nballs n a ...)
     (lambda ()
       (define result '())
       (define nums (iota (+ (* n (- n 1)) 1) 1))
       (combinations-for-each
	(lambda (x)
	  (permutations-for-each
	   (lambda (x)
	     (receive (a ...) (apply values (cons 1 x))
	       (when (and (= (+ (* n (- n 1)) 1) (+ a ...))
			  (lset= eq? nums (math-goodbye a ...)))
		 (push! result (list a ...)))))
	   (cons 2 x)))
	(iota (- (/ (* n (- n 1)) 2) 1) 3) 3)
       (delete-duplicates result same-answer?)))))

(define-macro (nballs n)
  `(nballs-helper ,n ,@(map (lambda _ (gensym)) (iota n))))

(define 8balls (nballs 8))