コード
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))