Project Euler(with Scheme) Problem 32

順列の生成で手間取っていたProblem32が無事解けた。よかったよかった。

順列の生成に関してはこのサイトを参考にした。とても分かりやすかった。

解法としては、
・1〜9を使った順列を生成
・全順列の、"×"と"="の位置を全部試す
というやり方。
大量の関数を書くことになり、正直手続き型(いつもだとJava)の方が簡単に書けるのかも知れなかったが、必要な関数をくみ上げていくのは楽しかったです。

Problem 32

(define (permutations-list ls)
    (define (perm ls a b)
        (if (null? ls)
            (cons (reverse a) b)
            (fold-right
                (lambda (x y)
                    (perm (remove-item x ls) (cons x a) y))
                b
                ls)))
    (perm ls '() '()))

(define (remove-item x ls)
    (remove (lambda (a) (equal? a x)) ls))

(define (remove func list)
  (cond ((null? list) list)
        ((func (car list)) (remove func (cdr list)))
        (#t (cons (car list) (remove func (cdr list))))))

(define (fold-right fn a ls . args)
  (if (null? args)
      (letrec ((recr
                 (lambda (a ls)
                   (if (null? ls)
                       a
                     (fn (car ls) (recr a (cdr ls)))))))
        (recr a ls))
    (letrec ((recr
               (lambda (a xs)
                 (if (member? '() xs)
                     a
                   (apply fn (append (map car xs)
                                     (list (recr a (map cdr xs)))))))))
      (recr a (cons ls args)))))

(define (union-add ele list)
  (if (null? list) (cons ele list)
      (if (= ele (car list)) list
          (cons (car list) (union-add ele (cdr list))))))

(define (union-list list1 list2)
  (if (null? list1) list2
      (union-list (cdr list1) (union-add (car list1) list2))))

(define (list-sep start end list);start番目からend番目の1つ前までをゲット
  (cond ((= end 1) '())
        ((= start 1) (cons (car list) (list-sep start (- end 1) (cdr list))))
        (#t (list-sep (- start 1) (- end 1) (cdr list)))))

(define (seki=? kake equ list)
  (= (* (tonum (list-sep 1 kake list)) (tonum (list-sep kake equ list))) (tonum (list-sep equ (+ (length list) 1) list))))

(define (tonum ls)
  (define (sub now list)
    (if (null? list) now
        (sub (+ (* now 10) (car list)) (cdr list))))
  (sub 0 ls))
;39 × 186 = 7254
;(seki=? 3 6 '(3 9 1 8 6 7 2 5 4)) -> #t

(define (all-check list)
  (define (sub kake equ)
    (let ((nextkake (if (= equ (+ kake 1)) 2 (+ kake 1)))
          (nextequ (if (= equ (+ kake 1)) (+ kake 2) equ))) 
     (cond ((= nextkake 9) '())
           ;((seki=? kake equ list) (cons (tonum (list-sep equ (+ 1 (length list)) list)) (sub nextkake nextequ)))
           ((and (seki=? kake equ list) (display (tonum (list-sep equ (+ 1 (length list)) list))) (newline)) (cons (tonum (list-sep equ (+ 1 (length list)) list)) (sub nextkake nextequ)))
           (#t (sub nextkake nextequ)))))
  (sub 2 3))
;(all-check '( 3 9 1 8 6 7 2 5 4)) -> (7254)

(define (listsum list)
  (if (null? list) 0
      (+ (car list) (listsum (cdr list)))))

(define (ans list)
  (define (sub anslist ls)
     (if (null? ls) (listsum anslist)
         (sub (union-list (all-check (car ls)) anslist) (cdr ls))))
   (sub '() list))

(display (ans (permutations-list '(1 2 3 4 5 6 7 8 9 ))))
(newline)