Project Euler Problem 21 - 25

	#lang racket
	(require srfi/1
	(except-in srfi/13
	string-hash)
	srfi/41
	(except-in srfi/69
	string-hash)
	(except-in math/number-theory
	permutations))
	;;;d(n) を n の真の約数の和と定義する. (真の約数とは n 以外の約数のことである. )
	;;;もし, d(a) = b かつ d(b) = a (a ≠ b のとき) を満たすとき,
	;;;a と b は友愛数(親和数)であるという.
	;;;
	;;;例えば, 220 の約数は 1, 2, 4, 5, 10, 11, 20, 22, 44, 55, 110 なので d(220) = 284 である.
	;;;また, 284 の約数は 1, 2, 4, 71, 142 なので d(284) = 220 である.
	;;;
	;;;それでは10000未満の友愛数の和を求めよ.
	(define (problem21 n)
	(define (d n)
	(fold + 0
	(remove (lambda (x)
	(= n x)) (divisors n))))
	(define (amicable? a)
	(let ((b (d a)))
	(and (not (= a b)) (= a (d b)))))
	(let ((amicable-stream (stream-filter amicable? (stream-from 0))))
	(stream-fold + 0 (stream-take-while (lambda (x) (< x n)) amicable-stream))))
	(problem21 10000)
	;;;5000個以上の名前が書かれている46Kのテキストファイル names.txt を用いる.
	;;;まずアルファベット順にソートせよ.
	;;;
	;;;のち, 各名前についてアルファベットに値を割り振り,
	;;;リスト中の出現順の数と掛け合わせることで, 名前のスコアを計算する.
	;;;
	;;;たとえば, リストがアルファベット順にソートされているとすると,
	;;;COLINはリストの938番目にある.
	;;;またCOLINは 3 + 15 + 12 + 9 + 14 = 53 という値を持つ.
	;;;よってCOLINは 938 × 53 = 49714 というスコアを持つ.
	;;;
	;;;ファイル中の全名前のスコアの合計を求めよ.
	(define (problem22 filename)
	(define (read-file)
	(with-input-from-file filename
	(lambda ()
	(let loop ((ls1 '()) (c (read-char)))
	(if (eof-object? c)
	(sort
	(string-tokenize
	(list->string (reverse (remove (lambda (x)
	(char=? x #\,)) ls1))))
	string<?)
	(loop (if (char=? c #\")
	(cons #\space ls1)
	(cons c ls1)) (read-char)))))))
	(define (alphabetical-value ls)
	(define (proc str)
	(apply +
	(map (lambda (x)
	(- (char->integer x) (char->integer #\@)))
	(string->list str))))
	(list->vector (map proc ls)))
	(define (calc-score vec)
	(let ((l (vector-length vec)))
	(let loop ((k 0) (acc 0))
	(if (= k l)
	acc
	(loop (+ k 1) (+ (* (vector-ref vec k) (+ k 1)) acc))))))
	(calc-score (alphabetical-value (read-file))))
	(problem22 "names.txt")
	;;;完全数とは, その数の真の約数の和がそれ自身と一致する数のことである.
	;;;たとえば, 28の真の約数の和は, 1 + 2 + 4 + 7 + 14 = 28 であるので, 28 は完全数である.
	;;;
	;;;真の約数の和がその数よりも少ないものを不足数といい,
	;;;真の約数の和がその数よりも大きいものを過剰数と呼ぶ.
	;;;
	;;;12は, 1 + 2 + 3 + 4 + 6 = 16 となるので, 最小の過剰数である.
	;;;よって2つの過剰数の和で書ける最少の数は24である.
	;;;数学的な解析により, 28123より大きい任意の整数は2つの過剰数の和で書けることが知られている.
	;;;2つの過剰数の和で表せない最大の数がこの上限よりも小さいことは分かっているのだが,
	;;;この上限を減らすことが出来ていない.
	;;;
	;;;2つの過剰数の和で書き表せない正の整数の総和を求めよ.
	(define (problem23 n)
	(let ((integers (stream-from 1)))
	(define (abundant? n)
	(> (apply + (divisors n)) (* 2 n)))
	(let ((abundant-stream
	(stream-filter abundant? integers)))
	(define (make-abundant?-stream strm)
	(stream-cons (abundant? (stream-car strm))
	(make-abundant?-stream (stream-cdr strm))))
	(let ((abundant?-stream (make-abundant?-stream integers))
	(abundant?-table (make-hash-table eqv?))
	(abundant-list '()))
	(define (not-sum-of-two-abundant? n arg)
	(let ((i (if (or (null? abundant-list) (<= (length abundant-list) arg))
	(let ((val (stream-ref abundant-stream arg)))
	(set! abundant-list `(,@abundant-list ,val))
	val)
	(list-ref abundant-list arg))))
	(if (or (<= n i) (> i (/ n 2)))
	#t
	(let ((key (- n i)))
	(let ((val (hash-table-ref/default abundant?-table key '())))
	(let ((val (if (null? val)
	(let ((obj (stream-ref abundant?-stream (- key 1))))
	(hash-table-set! abundant?-table key obj)
	obj)
	val)))
	(if val
	#f
	(not-sum-of-two-abundant? n (+ arg 1)))))))))
	(stream-fold + 0 (stream-filter (lambda (x)
	(not-sum-of-two-abundant? x 0))
	(stream-range 1 (+ n 1))))))))
	(problem23 28123)
	;;;順列とはモノの順番付きの並びのことである.
	;;;たとえば, 3124は数 1, 2, 3, 4 の一つの順列である.
	;;;すべての順列を数の大小でまたは辞書式に並べたものを辞書順と呼ぶ.
	;;;0と1と2の順列を辞書順に並べると
	;;;
	;;;012 021 102 120 201 210
	;;;
	;;;になる.
	;;;
	;;;0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目はいくつか?
	(define (problem24 str n)
	(define (surplus)
	(let loop ((n (- n 1)) (count (string-length str)) (k 1) (acc '()))
	(if (zero? count)
	acc
	(loop (quotient n k) (- count 1) (+ k 1)
	(cons (modulo n k) acc)))))
	(define (order ls)
	(let loop ((ls0 ls) (ls1 (string->list str)) (acc '()))
	(if (null? ls0)
	(list->string (reverse acc))
	(let ((i (car ls0)))
	(let-values (((ls-a ls-b) (split-at ls1 i)))
	(loop (cdr ls0)
	(append ls-a (cdr ls-b))
	(cons (car ls-b) acc)))))))
	(order (surplus)))
	(problem24 "0123456789" 1000000)
	;;;フィボナッチ数列は以下の漸化式で定義される:
	;;;Fn = Fn-1 + Fn-2, ただし F1 = 1, F2 = 1.
	;;;
	;;;最初の12項は以下である.
	;;;
	;;; F1 = 1
	;;; F2 = 1
	;;; F3 = 2
	;;; F4 = 3
	;;; F5 = 5
	;;; F6 = 8
	;;; F7 = 13
	;;; F8 = 21
	;;; F9 = 34
	;;; F10 = 55
	;;; F11 = 89
	;;; F12 = 144
	;;;
	;;;12番目の項, F12が3桁になる最初の項である.
	;;;
	;;;1000桁になる最初の項の番号を答えよ.
	(define (problem25 n)
	(define fib
	(stream-cons 1
	(stream-cons 1
	(stream-map + fib
	(stream-cdr fib)))))
	(+ 1
	(stream-length (stream-take-while (lambda (x)
	(< (string-length
	(number->string x))
	n)) fib))))
	(problem25 1000)

view raw projectEuler21-25.rkt hosted with ❤ by GitHub