Problem 32 - 積の組合せ

Scheme

ぜぃぜい。やっと解けた。

Problem 32 - PukiWiki

39 × 186 = 7254のように1から9が一回づつ現われる積の組合せを見つける。


積の組合せは

  • 1桁 * 4桁 = 4桁
  • 2桁 * 3桁 = 4桁

しかない。

ということで、

  • 1〜9の中から、1桁or2桁の順列を求める。
  • 差集合を取って、4桁or3桁の順列を求める。
  • 掛け算して、残りと比べる。
  • 重複が出るっぽいのでunique (和集合でよさげ)

やることはシンプルなんだけど、やたらなげぇ。

(define (unique list)
  (fold-right
    (lambda (a b)
      (if (member a b)
          b
          (cons a b)))
    '() list))

(define (list->number l)
  (letrec ((iter (lambda (l cont)
                  (if (null? l)
                      (cont 0 0)
                      (iter (cdr l) (lambda (sum k)
                                      (cont (+ (* (car l) (expt 10 k)) sum)
                                            (+ k 1))))))))
          (iter l (lambda (sum k) sum))))

(define (number->list n . base)
  (letrec ((b (if (null? base) 10 (car base)))
           (iter (lambda (acc n)
                   (let ((q (quotient n b))
                         (m (cons (modulo n b) acc)))
                        (if (zero? q)
                            m
                            (iter m q))))))
          (iter '() n)))

(define (permutations s . m)
  (letrec ((flatmap (lambda (proc s)
                      (apply append (map proc s))))
           (remove-1 (lambda (item s)
                       (cond ((null? s) '())
                             ((equal? (car s) item) (cdr s))
                             (else (cons (car s)
                                         (remove-1 item (cdr s)))))))
           (iter (lambda (s m)
                   (if (or (zero? m) (null? s))
                       (list '())
                       (flatmap (lambda (l)
                                  (map (lambda (p) (cons l p))
                                       (permutations (remove-1 l s) (- m 1))))
                                s)))))
          (iter s (if (null? m) (length s) (car m)))))

(define (problem32)
  (letrec ((diff (lambda (a b) (lset-difference = a b)))
           (seed (iota 9 1))
           (iter
             (lambda (n)
               (if (= n 3)
                   '()
                   (append
                     (fold
                       (lambda (l acc)
                         (let* ((d (diff seed l))
                                (p (permutations d (- 5 n))))
                           (append
                             (fold
                               (lambda (x acd)
                                 (let* ((res (* (list->number l) (list->number x)))
                                        (res-l (number->list res))
                                        (diff-dx (diff d x)))
                                   (if (and (= (length diff-dx)
                                               (length res-l))
                                            (null? (diff diff-dx res-l)))
                                       (cons res acd)
                                       acd)))
                               '() p)
                             acc)))
                       '()
                       (permutations seed n))
                     (iter (+ n 1)))))))
    (apply + (unique (iter 1)))))

もうちょっと短く書きたいところ・・・。