December 30, 2008
at
Tuesday, December 30, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
Let d(n) be defined as the sum of proper divisors of n (numbers less than n which divide evenly into n).
If d(a) = b and d(b) = a, where a ≠ b, then a and b are an amicable pair and each of a and b are called amicable numbers.
For example, the proper divisors of 220 are 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 and 110 therefore d(220) = 284. The proper divisors of 284 are 1, 2, 4, 71 and 142 so d(284) = 220.
Evaluate the sum of all the amicable numbers under 10000.
(defun divisor-p (num divisor)
"Tests if divisor is a divisor of num"
(zerop (mod num divisor)))
(defun divisors (num)
"Returns a list of num's divisors"
(do ((i 2 (1+ i))
(result '(1)))
((> i (isqrt num)) (remove-duplicates result))
(when (divisor-p num i)
(setf result (append result (list i (/ num i)))))))
(defun sum-divisors (num)
"Sums the divisors of num"
(reduce #'+ (divisors num)))
(defun amicable-p (num)
"Tests if num is amicable"
(let ((divisors-sum (sum-divisors num)))
(when (and (= num (sum-divisors divisors-sum))
(not (= num divisors-sum)))
num)))
(defun amicable-sum (limit)
"Returns the sum of all amicable numbers below limit"
(do ((i 1 (1+ i))
(result 0))
((>= i limit) result)
(when (amicable-p i)
(incf result i))))
(defun euler-21 ()
(amicable-sum 10000))
at
Tuesday, December 30, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
n! means n × (n − 1) × ... × 3 × 2 × 1
Find the sum of the digits in the number 100!
(defun add-digits (num)
"Returns the sum of the number's digits"
(let ((sum 0)
(num-string (write-to-string num)))
(dotimes (i (length num-string))
(setf sum (+ sum (digit-char-p (schar num-string i)))))
sum))
(defun fact (num)
(if (= num 1)
1
(* num (fact (1- num)))))
(defun euler-20 ()
(add-digits (fact 100)))
at
Tuesday, December 30, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
You are given the following information, but you may prefer to do some research for yourself.
* 1 Jan 1900 was a Monday.
* Thirty days has September,
April, June and November.
All the rest have thirty-one,
Saving February alone,
Which has twenty-eight, rain or shine.
And on leap years, twenty-nine.
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.
How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?
(defconstant +months+ '("Jan" "Feb" "Mar" "April" "May" "June"
"July" "Aug" "Sept" "Oct" "Nov" "Dec"))
(defconstant +days+ '("Sun" "Mon" "Tue" "Wed" "Thurs" "Fri" "Sat"))
(defun days-in-month (month year)
"Returns the number of days in the month given the month and year"
(cond ((member month '("Sept" "April" "June" "Nov") :test #'string=)
30)
((and (string= "Feb" month) (zerop (mod year 4))) 29)
((string= "Feb" month) 28)
(t 31)))
(defun move-ahead (today days)
"Moves ahead a number of days and returns the day.
Example: (move-ahead 'Mon' 3) => 'Thurs'
(move-ahead 'Sun' 8) => 'Mon'"
(let ((cur-day-num (position today +days+ :test #'string=)))
(elt +days+ (mod (+ cur-day-num days) 7))))
(defun euler-19 ()
(let ((today "Mon")
(result 0))
(loop for year from 1900 to 2000 do
(dolist (month +months+)
(when (and (string= today "Sun") (> year 1900))
(incf result))
(setf today (move-ahead today (days-in-month month year)))))
result))
at
Tuesday, December 30, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
By starting at the top of the triangle below and moving to adjacent numbers on the row below, the maximum total from top to bottom is 23.
3
7 5
2 4 6
8 5 9 3
That is, 3 + 7 + 4 + 9 = 23.
Find the maximum total from top to bottom of the triangle below:
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
NOTE: As there are only 16384 routes, it is possible to solve this problem by trying every route. However, Problem 67, is the same challenge with a triangle containing one-hundred rows it cannot be solved by brute force, and requires a clever method! ;o)
This problem is best solved by starting at the base and working up. Increment the number above each pair of nodes by the largest of the two nodes, and continue until you reach the top.
(defconstant +triangle+
'(
(75)
(95 64)
(17 47 82)
(18 35 87 10)
(20 04 82 47 65)
(19 01 23 75 03 34)
(88 02 77 73 07 63 67)
(99 65 04 28 06 16 70 92)
(41 41 26 56 83 40 80 70 33)
(41 48 72 33 47 32 37 16 94 29)
(53 71 44 65 25 43 91 52 97 51 14)
(70 11 33 28 77 73 17 78 39 68 17 57)
(91 71 52 38 17 14 91 43 58 50 27 29 48)
(63 66 04 68 89 53 67 30 73 16 69 87 40 31)
(04 62 98 27 23 09 70 98 73 93 38 53 60 04 23)))
(defun bottom-two-rows (triangle)
"Returns the bottom two rows of a triangle"
(list (car (last (butlast triangle)))
(car (last triangle))))
(defun first-node-and-stems (triangle)
"Given two rows of a triangle, returns the first node and the
first node's stems.
Example: (first-node-and-stems '((2 4 6) (8 5 9 3))) => 2 8 5"
(let ((node (caar triangle))
(left-stem (first (cadr triangle)))
(right-stem (second (cadr triangle))))
(values node left-stem right-stem)))
(defun max-node (node left-stem right-stem)
(max (+ node left-stem)
(+ node right-stem)))
(defun sum-stems (rows)
"Given two adjacent rows of a triangle, returns a list of the
maximum total of the stems for each node.
Example: (sum-stems '((2 4 6) (8 5 9 3))) => (10 13 15)"
(when (first rows)
(multiple-value-bind (node left-stem right-stem)
(first-node-and-stems rows)
(cons (max-node node left-stem right-stem)
(sum-stems (mapcar #'cdr rows))))))
(defun max-route (triangle)
"Returns the sum of the route that produces the maximum total of
the given triangle"
(if (= (length triangle) 2)
(multiple-value-bind (node left-stem right-stem)
(first-node-and-stems triangle)
(max-node node left-stem right-stem))
(max-route (append (butlast (butlast triangle))
(list (sum-stems
(bottom-two-rows triangle)))))))
(defun euler-18 ()
(max-route +triangle+))
at
Tuesday, December 30, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.
If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used?
NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of "and" when writing out numbers is in compliance with British usage.
(defun remove-hyphens (str)
"Removes any hyphens from str"
(remove #\- str))
(defun remove-spaces (str)
"Removes any spaces from str"
(remove #\Space str))
(defun euler-17 ()
(+ (loop for i from 1 to 1000 sum
(length (remove-hyphens (remove-spaces
(format nil "~R" i)))))
;; SBCL does not include the word 'and', so add
;; those letters also
(* 3 99 9)))
December 21, 2008
at
Sunday, December 21, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
2^(15) = 32768 and the sum of its digits is
3 + 2 + 7 + 6 + 8 = 26.
What is the sum of the digits of the number 2^(1000)?
(defun add-digits (num)
"Returns the sum of the number's digits"
(let ((sum 0)
(num-string (write-to-string num)))
(dotimes (i (length num-string))
(setf sum (+ sum (digit-char-p (schar num-string i)))))
sum))
(defun euler-16 ()
(add-digits (expt 2 1000)))
December 20, 2008
at
Saturday, December 20, 2008
Labels:
Computer Science,
Lisp,
Project Euler
Posted by
Billy
0
comments
Starting in the top left corner of a 2×2 grid, there are 6 routes (without backtracking) to the bottom right corner. How many routes are there through a 20×20 grid?
Since we can not backtrack, we can only move down and right. If we have a 2x2 grid, this means every route consists of exactly 2 right moves and 2 down moves. We can think of the routes as a set of moves, such as (d d r r), and the total number of routes will be all the different combinations of the set minus the identical combinations. To find the number of unique combinations, suppose we have the route (d d r r). Treating each move distinctly, lets write the set as (d1 d2 r1 r2). Notice how this route is equal to the route(d2 d1 r2 r1), and we only want to count this as one route. It turns out that the number of unique routes per combination is 2!*2! = 4: (d1 d2 r1 r2) (d1 d2 r2 r1) (d2 d1 r1 r2)(d2 d1 r2 r1). This means each route in the set of all possible route combinations, 4!, will have 3 other identical routes in the set, resulting in 4!/(2!2!) unique routes. This formula applies to larger grids as well.
(defun factorial (n &optional (acc 1))
(if (<= n 1)
acc
(factorial (- n 1) (* acc n))))
(defun grid-routes (x-dim y-dim)
"Calculates the number of routes from the top left corner
of a grid to the bottom right corner, without backtracking"
(let ((total-number-of-moves (+ x-dim y-dim)))
(/ (factorial total-number-of-moves)
(* (factorial x-dim)
(factorial y-dim)))))
(defun euler-15 ()
(grid-routes 20 20))
Subscribe to:
Posts (Atom)