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の整数です。これを求めよ。

• http://haskell.g.hatena.ne.jp/nobsun/20061019 を参考に、ambで実装したものです。ambはlistをとれるように改造しました。 - gemma(2006/10/20 19:33:18 PDT)

  (use srfi-1)
  
  ;; stack of cc.
  (define fail '())
  
  ;; nondeterminsm operator
  (define (amb li)
    (if (null? li)
        ((pop! fail))
        (call/cc
         (lambda (cc)
           (push! fail (lambda ()
                         (cc (amb (cdr li)))))
           (car li)))))
  
  (define (toint li)
    (fold (lambda (a b) (+ a (* b 10))) 0 li))
  
  (define (solve)
    (let ((digs (iota 10 0))
          (digs1 (iota 9 1)))
      (let* ((S (amb digs1))
               (E (amb (lset-difference = digs (list S))))
               (N (amb (lset-difference = digs (list S E))))
               (D (amb (lset-difference = digs (list S E N))))
               (M (amb (lset-difference = digs1 (list S E N D))))
               (O (amb (lset-difference = digs (list S E N D M))))
               (R (amb (lset-difference = digs (list S E N D M O))))
               (Y (amb (lset-difference = digs (list S E N D M O R)))))
        (if
         (= (+ (toint (list S E N D))
               (toint (list M O R E)))
            (toint (list M O N E Y)))
         (list S E N D '+ M O R E '= M O N E Y)
         (amb '())))))
  
  (print
   (call/cc
    (lambda (cc)
      ;; initial value for fail
      (push! fail
             (lambda ()
               (cc 'no-choise)))
      (solve))))
  

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)))

• なるほど、短い! - gemma(2006/10/21 08:33:38 PDT)

条件に合致する連想リストを返す。 最初に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