プロジェクト・オイラー 001-008

　勉強がてらProject Eulerをやっています。まず1から8まで。使用している言語/処理系はScheme/Gaucheです。

;; Project Euler
;; http://odz.sakura.ne.jp/projecteuler/


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 指定した自然数 n で割り切れるかを判定する関数を創る関数
;; 戻り値　1引数の関数
;; 引数　1つの自然数 (n)
(define (mod-n n)
  (if (zero? n)
      (error "Natural number required, but got zero.")
      (lambda (x)
 (if (zero? (modulo x n))
     #t
     #f))))

;; 指定した2つの自然数からなる集合の環集合を返す
;; 戻り値　自然数のリスト
;; 引数　自然数からなる2つのリスト
(define (union l1 l2)
  (cond
   ((null? l1) l2)
   ((null? l2) l1)
   (else
    (lset-union eq? l1 l2))))

;; 引数nが3で割り切れるか判定する
;; 戻り値　真偽値
;; 引数　自然数 n
(define (mod3? n)
  ((mod-n 3) n))

;; 引数nが5で割り切れるか判定する
;; 戻り値　真偽値
;; 引数　自然数 n
(define (mod5? n)
  ((mod-n 5) n))

(mod5? 10)
(mod5? 11)

;; プロジェクトオイラーの問題1のメイン
;; 与えられた自然数からなるリストの内、3の倍数と5の倍数の総和を求める
;; 戻り値　1つの自然数(3の倍数と5の倍数の総和)
;; 引数 自然数からなる1つのリスト l
(define (pj-euler1 l)
  (cond
   ((null? l) 0)
   (else
    (fold + 0
   (union 
    (filter mod3? l) 
    (filter mod5? l))))))

(pj-euler1 (iota 1000))
(pj-euler1 (iota 10))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; n項までのフィボナッチ数を求める
;; 戻り値　自然数(フィボナッチ数)
;; 引数　自然数 n
(define (fibo n)
  (cond
   ((zero? n) 1)
   ((zero? (- n 1)) 2)
   (else
    (+ (fibo (- n 1)) (fibo (- n 2))))))

(time (fibo 100))

;; CPS版フィボナッチ数
(define (fibo/cps n cont)
  (cond
   ((zero? n) (cont 1))
   ((zero? (- n 1)) (cont 2))
   (else
    (fibo/cps (- n 1) 
       (lambda (y) (fibo/cps (- n 2) 
        (lambda (z) (cont (+ y z)))))))))

(time (fibo/cps 100 (lambda (x) x)))

;; tati
(define (fib-i n)
  (if (or (zero? n) (= n 1))
      (values 1 1)
      (receive (cur prev)
   (fib-i (- n 1))
 (values (+ cur prev) cur))))

;;動的計画法版フィボナッチ数
(define (fibo/dyna n)
  (let loop ((a 1) (b 2) (i n))
    (let1 c (+ a b)
      (if (<= i 2)
   c
   (loop b c (- i 1))))))


;; n以下のフィボナッチ数の内偶数の物を返す
(time (let loop ((n 0) (ret 0))
  (let1 f (fibo/dyna n)
    (if (< f 4000000)
 (if (even? f)
     (loop (+ n 1) (+ ret f))
     (loop (+ n 1) ret)))
 ret)))
   

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(use srfi-1)

;; 与えられた自然数 n 以下の素数のリストを返す
;; 戻り値　n 以下の素数のリスト
;; 引数　n 閾値となる自然数
(define (primes n)
  (let loop ((l (unfold (cut > <> n) values (cut + <> 2) 3))
             (prime-list '(2)))
    (let1 m (car l)
      (if (> (expt m 2) n)
   (append (reverse prime-list) l)
   (loop (remove (lambda (x) (zero? (modulo x m))) l) (cons m prime-list))))))

(define val 600851475143)
(define plist (reverse (primes (truncate (sqrt val)))))
(
(define (pj-euler3 n ls)
  (cond
   ((zero? n) 0)
   ((null? ls) (error "list required, but got ()"))
   (else
    (if (zero? (modulo n (car ls)))
 (car ls)
 (pj-euler3 n (cdr ls))))))

(time (pj-euler3 val (reverse (primes (truncate (sqrt val))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 4
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use srfi-13)

(* 999 999)
(string-reverse (number->string 123))

;; 与えられた数が回文数か判定する関数
(define (palindromic? n)
  (cond
   ((zero? n) #t)
   ((< n 10) #t)
   (else
    (let* ((stringed-n (number->string n))
   (reversed-n (string-reverse stringed-n)))
      (string=? stringed-n reversed-n)))))

(define pal 

;; 入力した自然数の平方根が整数になるか調べる関数
(define (sq-int? n)
  (integer? (sqrt n)))

(time (take-right (filter sq-int? (filter palindromic? (iota (- (* 999 999) (* 100 100)) (* 100 100)))) 1))


(sqrt 10201)

  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 5
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define max-v (lcm 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20))

(define (lcm? n)
  (if (zero? n) #f
   (and
    (zero? (modulo n 20))
    (zero? (modulo n 19))
    (zero? (modulo n 18))
    (zero? (modulo n 17))
    (zero? (modulo n 16))
    (zero? (modulo n 15))
    (zero? (modulo n 14))
    (zero? (modulo n 13))
    (zero? (modulo n 12))
    (zero? (modulo n 11)))))

(time (length (iota max-v -20)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 6
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use srfi-1)

(define n 100)

(define (pj-euler6 n)
  (- (expt (apply + (iota n 1)) 2)
     (apply + (map (lambda (x) (* x x)) (iota n 1)))))

(time (pj-euler6 n))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 7
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define idx 10001)

(time (list-ref (primes (* 50 idx)) idx))

(use util.stream)
(use srfi-42)
(define (primes-shiro)
  (stream-filter (lambda (k)
     (not (any?-ec (: j 3 (sqrt k) 2) (zero? (modulo k j)))))
   (stream-cons 2 (stream-iota -1 3 2))))

(time (stream->list (stream-take (primes-shiro) idx)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Problem 8
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define quant 7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450)

(define (integer->list i)
  (letrec ((i->rl (lambda (j)
      (cons (modulo j 10)
     (if (< j 10)
         '()
         (i->rl (quotient j 10)))))))
    (reverse (i->rl i))))

(define (1st l)
  (car l))
(define (2nd l)
  (car (cdr l)))
(define (3rd l)
  (car (cdr (cdr l))))
(define (4th l)
  (car (cdr (cdr (cdr l)))))
(define (5th l)
  (car (cdr (cdr (cdr (cdr l))))))

(define l (integer->list 7316717653133062491922511967442657474))

(define (pj-euler8 l)
  (cond
   ((> 5 (length l)) '())
   (else
    (cons (* (1st l) (2nd l) (3rd l) (4th l) (5th l)) (pj-euler8 (cdr l))))))
  
(time (apply max (pj-euler8 (integer->list quant))))