Scheme:数遊び:SEND+MORE=MONEY

Scheme:数遊び:SEND+MORE=MONEY

Scheme:数遊びのサブページ

SEND + MORE = MONEY

gemma(2006/10/18 23:12:24 PDT) OCaml-nagoyaネタ記録庫と、らくがきえんじんより

  S E N D
+ M O R E
----------
M O N E Y
(S,M != 0)
S,E,N,D,M,O,R,Yはユニークな0..9の整数です。これを求めよ。

Shiro: util.combinationsを使ったナイーブな総当たり。 しかも短く書くためにわざわざ文字列を経由して計算するという富豪コード。

(use util.combinations)
(use util.match)

(define (solve)
  (let/cc return
    (combinations-for-each
     (cut permutations-for-each
          (match-lambda ((S E N D M O R Y)
                         (and (not (eqv? S #\0)) (not (eqv? M #\0))
                              (let ((SEND  (x->integer (string S E N D)))
                                    (MORE  (x->integer (string M O R E)))
                                    (MONEY (x->integer (string M O N E Y))))
                                (when (= (+ SEND MORE) MONEY)
                                  (return SEND MORE MONEY))))))
          <>)
     (string->list "0123456789") 8)))

条件に合致する連想リストを返す。 最初にkeyがとる値の範囲をリストにした連想リストを渡す。

(define (alist-filter f a)
  (let loop ((alist '()))
    (call-with-current-continuation
     (lambda (cont)
       (define (cont-assoc key alist)
         (define (next y)
           (define (g z) (cons (cons key z) alist))
           (cont (apply append (map loop (map g (cdr y))))))
         (cond ((assoc key alist) => (lambda (x) x))
               ((assoc key a) => next)
               (else #f)))
       (if (f cont-assoc alist) (list alist) '())))))

(let ((a '(S E N D)) (b '(M O R E)) (c '(M O N E Y)))
  (define (f assoc alist)
    (define (value key) (cdr (assoc key alist)))
    (define (uniq-num? x) (not (member x (cdr (member x (map cdr alist))))))
    (let loop ((a (reverse a)) (b (reverse b)) (c (reverse c)) (n 0) (base 1))
      (cond ((null? c) #t)
            ((or (null? a) (null? b))
             (and (>= n base) (= (value (car c)) 1) (uniq-num? 1)))
            (else
             (let ((a1 (value (car a))) (b1 (value (car b))) (c1 (value (car c))))
               (and (uniq-num? a1) (uniq-num? b1) (uniq-num? c1)
                    (= (remainder (+ a1 b1 (if (>= n base) 1 0)) 10) c1)
                    (loop (cdr a) (cdr b) (cdr c)
                          (+ (* (+ a1 b1) base) n) (* base 10))))))))
  (define (g x) (list x 1 2 3 4 5 6 7 8 9 0))
  (display (alist-filter f (map g (append a b c)))) (newline))

Tag: Puzzle

More ...