初めに

今までLISPは食わず嫌い的に敬遠していたのですが，最近大学の授業でSchemeを使う機会があり，いざちゃんと勉強してみると結構面白くて，ずぶずぶと沼にハマっていく音が聞こえてきました．ちなみに最近LoL本買っちゃいました😉

Schemeを最初に触ってから1ヶ月くらい経ったあたりでなんとなくProject Eulerを解いていたので，この記事ではそのコード片を紹介したいと思います．なお，本記事のコードは全てGitHubにあげています(今後も継続的にcommitしていく予定です)．

kagemiku/project-euler

(カレンダーに登録してから昨年のLisp Advent Calendarを見たのですが，そのあまりのレベルの高さに登録してしまったことを若干後悔していたのはここだけの秘密です)

Project Eulerとは

Project Eulerとは，かなりざっくり説明すると，「プログラムで解くことを前提とした数学的な問題集」です．

時間ができたときにコツコツ的な感じでやっているので，筆者はまだ5問ほどしか解けていません．

心のどこかに留めておいて欲しいこと

筆者は数弱
筆者は競プロ弱者
筆者はScheme弱者(故に車輪の再発明な関数を書いている可能性があります)
処理系はRacketを使用
問題文はゆるふわ和訳
マサカリ含むアドバイスは大歓迎です(泣いて喜びます😂)

コード

[Problem 1] Multiples of 3 and 5

1000未満の整数で，3または5の倍数である値を全て足し合わせるといくらか?

#lang racket

; xがyの倍数なら#t
(define (divisor? x y)
  (= (remainder x y) 0))

; [bgn, end)の範囲で整数列を生成
(define (range-list bgn end)
  (if (>= bgn end)
    '()
    (cons bgn (range-list (+ bgn 1) end))))

; ソルバ
; num未満の整数で，3または5の倍数である値のsumを返却
(define (solver num)
  (apply + (filter
             (lambda (x) (or (divisor? x 3) (divisor? x 5)))
             (range-list 2 num))))

(solver 1000)

Problem 1はとりあえずやるだけ的な問題です．

[Problem 2] Even Fibonacci numbers

4,000,000を超えないフィボナッチ数列の項の中から，偶数である項を全て足し合わせるといくらか?

#lang racket

; ソルバ
; num以下のフィボナッチ数列の各項の内，偶数である項のsumを返却
(define (solver num)
  (let loop((n1 1) (n2 2) (ret 2))
    (let ((n3 (+ n1 n2)))
      (cond
        ((> n3 num) ret)
        ((even? n3) (loop n2 n3 (+ ret n3)))
        (else (loop n2 n3 ret))))))

(solver 4000000)

ループ使って愚直に解きました．まだ遅延リストとか知らない時期に書いたものなので改善の余地はめちゃくちゃありそう．

[Problem 3] Largest prime factor

600851475143の素因数の中で最も大きい素因数はいくらか?

#lang racket

; xがyの倍数なら#t
(define (divisor? x y)
  (= (remainder x y) 0))

; ソルバ
; numの素因数の最大値を返却
(define (solver num)
  (let loop((x num) (factor 2))
    (cond
      ((= x 1) factor)
      ((divisor? x factor) (loop (/ x factor) factor))
      (else (loop x (+ factor 1))))))

(solver 600851475143)

同じ値で割り切れなくなるまで割り続けて，割れ切れなくなったら除数の値を増やす感じです．

[Problem 4] Largest palindrome product

3桁の整数を2つ掛け合わせてできる回文数(9009みたいに上位桁から見ても下位桁からみても数字の並びが同じ数)のうち，最大の値はいくらか?

#lang racket

; 整数であるnumberを各桁の値のリストに変換( 123 -> (1 2 3) )
(define (number->list number)
  (string->list (number->string number)))

; numが回文数なら#t
(define (palindromic? num)
  (let loop((ls0 (number->list num)) (ls1 (reverse (number->list num))) (cnt (truncate (/ (length (number->list num)) 2))))
    (cond
      ((<= cnt 0) #t)
      ((eqv? (car ls0) (car ls1)) (loop (cdr ls0) (cdr ls1) (- cnt 1)))
      (else #f))))

; max-num以下の2つの整数の積を全て計算してリストに入れて返却
(define (gen-muls max-num)
  (let loop((x max-num) (y max-num) (ret '()))
    (cond
      ((= y 0) ret)
      ((= x 0) (loop max-num (- y 1) ret))
      (else (loop (- x 1) y (cons (* x y) ret))))))

; ソルバ
; max-num以下の2つの整数を掛け合わせてできる最大の回文数を返却
(define (solver max-num)
  (apply max (filter palindromic? (gen-muls max-num))))

(solver 999)

このあたりからちょっと難しくなってきました．そしてコードも素直に書きすぎていてなかなかにひどいです… $O(mn^2)$はとってもヤバイ．

[Problem 5] Smallest multiple

1から20の間の整数全てで割り切ることのできる最小の整数はいくらか?

#lang racket

(require scheme/mpair)

; xがyの倍数なら#t
(define (divisor? x y)
  (= (remainder x y) 0))

; [bgn, end)の範囲でmutableな整数列を生成
(define (mrange-list bgn end)
  (if (>= bgn end)
    '()
    (mcons bgn (mrange-list (+ bgn 1) end))))

; リストmlsのidx番目の値をvalに変更
(define (change-elem! mls idx val)
  (if (<= idx 0)
    (set-mcar! mls val)
    (change-elem! (mcdr mls) (- idx 1) val)))

; change-elem!をstepの幅で繰り返し実行
(define (change-elems! mls bgn step val)
  (when (and (< bgn (mlength mls)) (>= step 0))
    (change-elem! mls bgn val)
    (change-elems! mls (+ bgn step) step val)))

; max-prime以下の素数列を生成
(define (gen-primes max-prime)
  (let loop((prime 2) (ret (mrange-list 2 (+ max-prime 1))))
    (cond
      ((>= prime max-prime) (filter number? (mlist->list ret)))
      ((number? (mlist-ref ret (- prime 2))) (change-elems! ret (+ (- prime 2) prime) prime #f) (loop (+ prime 1) ret))
      (else (loop (+ prime 1) ret)))))

; numの素因数列を生成
(define (gen-factors num primes)
  (let loop((n num) (factors primes) (ret '(1)))
    (cond
      ((= n 1) (reverse ret))
      ((divisor? n (car factors)) (loop (/ n (car factors)) factors (cons (car factors) ret)))
      (else (loop n (cdr factors) ret)))))

; リストls中のvalの個数を返却
(define (count-vals ls val)
  (count (lambda (x) (= x val)) ls))

; 素因数列を各素因数の冪数列に変換
; e.g. (2 2 2 3 5 5 11 11) -> (3 1 2 0 2)
(define (factors->powers factors primes)
  (if (null? primes)
    '()
    (cons (count-vals factors (car primes)) (factors->powers factors (cdr primes)))))

; ソルバ
; 2からmax-numの間の整数全てで割り切ることのできる最小の値を返却
(define (solver max-num)
  (let ((primes (gen-primes max-num)))
    (let loop((num 2) (ret (make-list (length primes) 0)))
      (if (> num max-num)
        (apply * (map expt primes ret))
        (loop (+ num 1) (map max ret (factors->powers (gen-factors num primes) primes)))))))

(solver 20)

だいぶごちゃごちゃしちゃってますね．(恐らく)高校1年の数学で習う，最小公倍数の求め方を利用して解きました．途中無駄な処理が多いかも．

終わりに

Schemeやる前は「小カッコであふれるコードとかキモすぎだろ😅」的に思っていたのですが，しばらく書いて慣れてくると，むしろまるまるっとしていて可愛ささえ感じるようになりました．

あとは副作用として，板書とかでカッコの数が対応しているか否かを瞬時に判断できるようになりました．LISPは神です．

今後もできるだけ問題の消化は続けて，1年後のLisp Advent Calendarでは圧倒的成長をした解答を載せたいです💪　マクロとか遅延リストとか継続をちゃんと使いたさ．

明日，4日目は「common lispで配布するアプリーケションの書きかた」です．よろしくお願い致します🙏

LISP(Scheme)でProject Eulerを解いてみる

初めに