summaryrefslogtreecommitdiff
path: root/euler12.scm
blob: e0d726f3cf2025d873c47a9d798be1344ecfe47c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(define (square x) (* x x))
(define (power x n)
 (if (= n 0)
  1
  (* x (power x (- n 1)))))

(define (first-divisor x)
 (define (try-iter d)
  (cond ((= 0 (remainder x d)) d)
   		((> (square d) x) x)
		(else (try-iter (+ d 1)))))
 (try-iter 2))

(define (divexp x d)
 (if (= (remainder x d) 0)
	(+ (divexp (/ x d) d) 1)
	0))
	
(define (ndiv n)
 (define (pair d)
  (cons (divexp n d) (/ n (expt d (divexp n d)))))
 (if (= n 1) 1
  (let ((fd (first-divisor n)))
   (* (+ 1 (car (pair fd)))
     (ndiv (cdr (pair fd)))))))

(define (kth-factor-triangle-over-n n)
 (define (n-fac-tri n)
  (if (even? n)
   (* (ndiv (/ n 2)) (ndiv (+ n 1)))
   (* (ndiv n) (ndiv (/ (+ n 1) 2)))))
 (define (try-iter i)
  (if (> (n-fac-tri i) n)
   i
   (try-iter (+ i 1))))
 (try-iter 1))

(display 
 ((lambda (x) (/ (* x (+ x 1)) 2))
  (kth-factor-triangle-over-n 500)))
(newline)