--- a/euler.asd Wed Aug 09 14:55:51 2017 -0400
+++ b/euler.asd Thu Aug 10 20:09:14 2017 -0400
@@ -27,6 +27,7 @@
(:module "src" :serial t
:components ((:file "primes")
(:file "utils")
- (:file "euler")
+ (:file "hungarian")
+ (:file "problems")
(:file "poker")))))
--- a/package.lisp Wed Aug 09 14:55:51 2017 -0400
+++ b/package.lisp Thu Aug 10 20:09:14 2017 -0400
@@ -15,3 +15,13 @@
:euler
:anaphora-basic
:euler.quickutils))
+
+(defpackage :euler.hungarian
+ (:use
+ :cl
+ :iterate
+ :losh
+ :euler
+ :euler.quickutils)
+ (:export
+ :find-minimal-assignment))
--- a/src/euler.lisp Wed Aug 09 14:55:51 2017 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1860 +0,0 @@
-(in-package :euler)
-
-(defun problem-1 ()
- ;; If we list all the natural numbers below 10 that are multiples of 3 or 5,
- ;; we get 3, 5, 6 and 9. The sum of these multiples is 23.
- ;;
- ;; Find the sum of all the multiples of 3 or 5 below 1000.
- (iterate (for i :from 1 :below 1000)
- (when (or (dividesp i 3)
- (dividesp i 5))
- (sum i))))
-
-(defun problem-2 ()
- ;; Each new term in the Fibonacci sequence is generated by adding the previous
- ;; two terms. By starting with 1 and 2, the first 10 terms will be:
- ;;
- ;; 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
- ;;
- ;; By considering the terms in the Fibonacci sequence whose values do not
- ;; exceed four million, find the sum of the even-valued terms.
- (iterate (for n :in-fibonacci t)
- (while (<= n 4000000))
- (when (evenp n)
- (sum n))))
-
-(defun problem-3 ()
- ;; The prime factors of 13195 are 5, 7, 13 and 29.
- ;;
- ;; What is the largest prime factor of the number 600851475143 ?
- (apply #'max (prime-factorization 600851475143)))
-
-(defun problem-4 ()
- ;; A palindromic number reads the same both ways. The largest palindrome made
- ;; from the product of two 2-digit numbers is 9009 = 91 × 99.
- ;;
- ;; Find the largest palindrome made from the product of two 3-digit numbers.
- (iterate (for-nested ((i :from 0 :to 999)
- (j :from 0 :to 999)))
- (for product = (* i j))
- (when (palindromep product)
- (maximize product))))
-
-(defun problem-5 ()
- ;; 2520 is the smallest number that can be divided by each of the numbers from
- ;; 1 to 10 without any remainder.
- ;;
- ;; What is the smallest positive number that is evenly divisible by all of the
- ;; numbers from 1 to 20?
- (iterate
- ;; all numbers are divisible by 1 and we can skip checking everything <= 10
- ;; because:
- ;;
- ;; anything divisible by 12 is automatically divisible by 2
- ;; anything divisible by 12 is automatically divisible by 3
- ;; anything divisible by 12 is automatically divisible by 4
- ;; anything divisible by 15 is automatically divisible by 5
- ;; anything divisible by 12 is automatically divisible by 6
- ;; anything divisible by 14 is automatically divisible by 7
- ;; anything divisible by 16 is automatically divisible by 8
- ;; anything divisible by 18 is automatically divisible by 9
- ;; anything divisible by 20 is automatically divisible by 10
- (with divisors = (range 11 20))
- (for i :from 20 :by 20) ; it must be divisible by 20
- (finding i :such-that (every (curry #'dividesp i) divisors))))
-
-(defun problem-6 ()
- ;; The sum of the squares of the first ten natural numbers is,
- ;; 1² + 2² + ... + 10² = 385
- ;;
- ;; The square of the sum of the first ten natural numbers is,
- ;; (1 + 2 + ... + 10)² = 55² = 3025
- ;;
- ;; Hence the difference between the sum of the squares of the first ten
- ;; natural numbers and the square of the sum is 3025 − 385 = 2640.
- ;;
- ;; Find the difference between the sum of the squares of the first one hundred
- ;; natural numbers and the square of the sum.
- (flet ((sum-of-squares (to)
- (sum (irange 1 to :key #'square)))
- (square-of-sum (to)
- (square (sum (irange 1 to)))))
- (abs (- (sum-of-squares 100) ; apparently it wants the absolute value
- (square-of-sum 100)))))
-
-(defun problem-7 ()
- ;; By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see
- ;; that the 6th prime is 13.
- ;;
- ;; What is the 10 001st prime number?
- (nth-prime 10001))
-
-(defun problem-8 ()
- ;; The four adjacent digits in the 1000-digit number that have the greatest
- ;; product are 9 × 9 × 8 × 9 = 5832.
- ;;
- ;; Find the thirteen adjacent digits in the 1000-digit number that have the
- ;; greatest product. What is the value of this product?
- (let ((digits (map 'list #'digit-char-p
- "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450")))
- (iterate (for window :in (n-grams 13 digits))
- (maximize (apply #'* window)))))
-
-(defun problem-9 ()
- ;; A Pythagorean triplet is a set of three natural numbers, a < b < c, for
- ;; which:
- ;;
- ;; a² + b² = c²
- ;;
- ;; For example, 3² + 4² = 9 + 16 = 25 = 5².
- ;;
- ;; There exists exactly one Pythagorean triplet for which a + b + c = 1000.
- ;; Find the product abc.
- (product (first (pythagorean-triplets-of-perimeter 1000))))
-
-(defun problem-10 ()
- ;; The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
- ;; Find the sum of all the primes below two million.
- (sum (sieve 2000000)))
-
-(defun problem-11 ()
- ;; In the 20×20 grid below, four numbers along a diagonal line have been marked
- ;; in red.
- ;;
- ;; The product of these numbers is 26 × 63 × 78 × 14 = 1788696.
- ;;
- ;; What is the greatest product of four adjacent numbers in the same direction
- ;; (up, down, left, right, or diagonally) in the 20×20 grid?
- (let ((grid
- #2A((08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08)
- (49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00)
- (81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65)
- (52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91)
- (22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80)
- (24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50)
- (32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70)
- (67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21)
- (24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72)
- (21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95)
- (78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92)
- (16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57)
- (86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58)
- (19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40)
- (04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66)
- (88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69)
- (04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36)
- (20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16)
- (20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54)
- (01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48))))
- (max
- ;; horizontal
- (iterate (for-nested ((row :from 0 :below 20)
- (col :from 0 :below 16)))
- (maximize (* (aref grid row (+ 0 col))
- (aref grid row (+ 1 col))
- (aref grid row (+ 2 col))
- (aref grid row (+ 3 col)))))
- ;; vertical
- (iterate (for-nested ((row :from 0 :below 16)
- (col :from 0 :below 20)))
- (maximize (* (aref grid (+ 0 row) col)
- (aref grid (+ 1 row) col)
- (aref grid (+ 2 row) col)
- (aref grid (+ 3 row) col))))
- ;; backslash \
- (iterate (for-nested ((row :from 0 :below 16)
- (col :from 0 :below 16)))
- (maximize (* (aref grid (+ 0 row) (+ 0 col))
- (aref grid (+ 1 row) (+ 1 col))
- (aref grid (+ 2 row) (+ 2 col))
- (aref grid (+ 3 row) (+ 3 col)))))
- ;; slash /
- (iterate (for-nested ((row :from 3 :below 20)
- (col :from 0 :below 16)))
- (maximize (* (aref grid (- row 0) (+ 0 col))
- (aref grid (- row 1) (+ 1 col))
- (aref grid (- row 2) (+ 2 col))
- (aref grid (- row 3) (+ 3 col))))))))
-
-(defun problem-12 ()
- ;; The sequence of triangle numbers is generated by adding the natural
- ;; numbers. So the 7th triangle number would be
- ;; 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. The first ten terms would be:
- ;;
- ;; 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
- ;;
- ;; Let us list the factors of the first seven triangle numbers:
- ;;
- ;; 1: 1
- ;; 3: 1,3
- ;; 6: 1,2,3,6
- ;; 10: 1,2,5,10
- ;; 15: 1,3,5,15
- ;; 21: 1,3,7,21
- ;; 28: 1,2,4,7,14,28
- ;;
- ;; We can see that 28 is the first triangle number to have over five divisors.
- ;;
- ;; What is the value of the first triangle number to have over five hundred
- ;; divisors?
- (iterate
- (for tri :key #'triangle :from 1)
- (finding tri :such-that (> (count-divisors tri) 500))))
-
-(defun problem-13 ()
- ;; Work out the first ten digits of the sum of the following one-hundred
- ;; 50-digit numbers.
- (-<> (+ 37107287533902102798797998220837590246510135740250
- 46376937677490009712648124896970078050417018260538
- 74324986199524741059474233309513058123726617309629
- 91942213363574161572522430563301811072406154908250
- 23067588207539346171171980310421047513778063246676
- 89261670696623633820136378418383684178734361726757
- 28112879812849979408065481931592621691275889832738
- 44274228917432520321923589422876796487670272189318
- 47451445736001306439091167216856844588711603153276
- 70386486105843025439939619828917593665686757934951
- 62176457141856560629502157223196586755079324193331
- 64906352462741904929101432445813822663347944758178
- 92575867718337217661963751590579239728245598838407
- 58203565325359399008402633568948830189458628227828
- 80181199384826282014278194139940567587151170094390
- 35398664372827112653829987240784473053190104293586
- 86515506006295864861532075273371959191420517255829
- 71693888707715466499115593487603532921714970056938
- 54370070576826684624621495650076471787294438377604
- 53282654108756828443191190634694037855217779295145
- 36123272525000296071075082563815656710885258350721
- 45876576172410976447339110607218265236877223636045
- 17423706905851860660448207621209813287860733969412
- 81142660418086830619328460811191061556940512689692
- 51934325451728388641918047049293215058642563049483
- 62467221648435076201727918039944693004732956340691
- 15732444386908125794514089057706229429197107928209
- 55037687525678773091862540744969844508330393682126
- 18336384825330154686196124348767681297534375946515
- 80386287592878490201521685554828717201219257766954
- 78182833757993103614740356856449095527097864797581
- 16726320100436897842553539920931837441497806860984
- 48403098129077791799088218795327364475675590848030
- 87086987551392711854517078544161852424320693150332
- 59959406895756536782107074926966537676326235447210
- 69793950679652694742597709739166693763042633987085
- 41052684708299085211399427365734116182760315001271
- 65378607361501080857009149939512557028198746004375
- 35829035317434717326932123578154982629742552737307
- 94953759765105305946966067683156574377167401875275
- 88902802571733229619176668713819931811048770190271
- 25267680276078003013678680992525463401061632866526
- 36270218540497705585629946580636237993140746255962
- 24074486908231174977792365466257246923322810917141
- 91430288197103288597806669760892938638285025333403
- 34413065578016127815921815005561868836468420090470
- 23053081172816430487623791969842487255036638784583
- 11487696932154902810424020138335124462181441773470
- 63783299490636259666498587618221225225512486764533
- 67720186971698544312419572409913959008952310058822
- 95548255300263520781532296796249481641953868218774
- 76085327132285723110424803456124867697064507995236
- 37774242535411291684276865538926205024910326572967
- 23701913275725675285653248258265463092207058596522
- 29798860272258331913126375147341994889534765745501
- 18495701454879288984856827726077713721403798879715
- 38298203783031473527721580348144513491373226651381
- 34829543829199918180278916522431027392251122869539
- 40957953066405232632538044100059654939159879593635
- 29746152185502371307642255121183693803580388584903
- 41698116222072977186158236678424689157993532961922
- 62467957194401269043877107275048102390895523597457
- 23189706772547915061505504953922979530901129967519
- 86188088225875314529584099251203829009407770775672
- 11306739708304724483816533873502340845647058077308
- 82959174767140363198008187129011875491310547126581
- 97623331044818386269515456334926366572897563400500
- 42846280183517070527831839425882145521227251250327
- 55121603546981200581762165212827652751691296897789
- 32238195734329339946437501907836945765883352399886
- 75506164965184775180738168837861091527357929701337
- 62177842752192623401942399639168044983993173312731
- 32924185707147349566916674687634660915035914677504
- 99518671430235219628894890102423325116913619626622
- 73267460800591547471830798392868535206946944540724
- 76841822524674417161514036427982273348055556214818
- 97142617910342598647204516893989422179826088076852
- 87783646182799346313767754307809363333018982642090
- 10848802521674670883215120185883543223812876952786
- 71329612474782464538636993009049310363619763878039
- 62184073572399794223406235393808339651327408011116
- 66627891981488087797941876876144230030984490851411
- 60661826293682836764744779239180335110989069790714
- 85786944089552990653640447425576083659976645795096
- 66024396409905389607120198219976047599490197230297
- 64913982680032973156037120041377903785566085089252
- 16730939319872750275468906903707539413042652315011
- 94809377245048795150954100921645863754710598436791
- 78639167021187492431995700641917969777599028300699
- 15368713711936614952811305876380278410754449733078
- 40789923115535562561142322423255033685442488917353
- 44889911501440648020369068063960672322193204149535
- 41503128880339536053299340368006977710650566631954
- 81234880673210146739058568557934581403627822703280
- 82616570773948327592232845941706525094512325230608
- 22918802058777319719839450180888072429661980811197
- 77158542502016545090413245809786882778948721859617
- 72107838435069186155435662884062257473692284509516
- 20849603980134001723930671666823555245252804609722
- 53503534226472524250874054075591789781264330331690)
- aesthetic-string
- (subseq <> 0 10)
- parse-integer
- (nth-value 0 <>)))
-
-(defun problem-14 ()
- ;; The following iterative sequence is defined for the set of positive
- ;; integers:
- ;;
- ;; n → n/2 (n is even)
- ;; n → 3n + 1 (n is odd)
- ;;
- ;; Using the rule above and starting with 13, we generate the following
- ;; sequence:
- ;;
- ;; 13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
- ;;
- ;; It can be seen that this sequence (starting at 13 and finishing at 1)
- ;; contains 10 terms. Although it has not been proved yet (Collatz Problem),
- ;; it is thought that all starting numbers finish at 1.
- ;;
- ;; Which starting number, under one million, produces the longest chain?
- ;;
- ;; NOTE: Once the chain starts the terms are allowed to go above one million.
- (iterate (for i :from 1 :below 1000000)
- (finding i :maximizing #'collatz-length)))
-
-(defun problem-15 ()
- ;; Starting in the top left corner of a 2×2 grid, and only being able to move
- ;; to the right and down, there are exactly 6 routes to the bottom right
- ;; corner.
- ;;
- ;; How many such routes are there through a 20×20 grid?
- (binomial-coefficient 40 20))
-
-(defun problem-16 ()
- ;; 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?
- (sum (digits (expt 2 1000))))
-
-(defun problem-17 ()
- ;; 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, which is awful.
- (labels ((letters (n)
- (-<> n
- (format nil "~R" <>)
- (count-if #'alpha-char-p <>)))
- (has-british-and (n)
- (or (< n 100)
- (zerop (mod n 100))))
- (silly-british-letters (n)
- (+ (letters n)
- (if (has-british-and n) 0 3))))
- (sum (irange 1 1000)
- :key #'silly-british-letters)))
-
-(defun problem-18 ()
- ;; 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 4
- ;; 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.
- ;;
- ;; 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)
- (let ((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))))
- (car (reduce (lambda (prev last)
- (mapcar #'+
- prev
- (mapcar #'max last (rest last))))
- triangle
- :from-end t))))
-
-(defun problem-19 ()
- ;; 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)?
- (iterate
- (for-nested ((year :from 1901 :to 2000)
- (month :from 1 :to 12)))
- (counting (-<> (local-time:encode-timestamp 0 0 0 0 1 month year)
- local-time:timestamp-day-of-week
- zerop))))
-
-(defun problem-20 ()
- ;; n! means n × (n − 1) × ... × 3 × 2 × 1
- ;;
- ;; For example, 10! = 10 × 9 × ... × 3 × 2 × 1 = 3628800,
- ;; and the sum of the digits in the number 10! is 3 + 6 + 2 + 8 + 8 + 0 + 0 = 27.
- ;;
- ;; Find the sum of the digits in the number 100!
- (sum (digits (factorial 100))))
-
-(defun problem-21 ()
- ;; 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.
- (labels ((sum-of-divisors (n)
- (sum (proper-divisors n)))
- (amicablep (n)
- (let ((other (sum-of-divisors n)))
- (and (not= n other)
- (= n (sum-of-divisors other))))))
- (sum (remove-if-not #'amicablep (range 1 10000)))))
-
-(defun problem-22 ()
- ;; Using names.txt, a 46K text file containing over five-thousand first names,
- ;; begin by sorting it into alphabetical order. Then working out the
- ;; alphabetical value for each name, multiply this value by its alphabetical
- ;; position in the list to obtain a name score.
- ;;
- ;; For example, when the list is sorted into alphabetical order, COLIN, which
- ;; is worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So,
- ;; COLIN would obtain a score of 938 × 53 = 49714.
- ;;
- ;; What is the total of all the name scores in the file?
- (labels ((read-names ()
- (-<> "data/22-names.txt"
- parse-strings-file
- (sort <> #'string<)))
- (name-score (name)
- (sum name :key #'letter-number)))
- (iterate (for (position . name) :in
- (enumerate (read-names) :start 1))
- (sum (* position (name-score name))))))
-
-(defun problem-23 ()
- ;; A perfect number is a number for which the sum of its proper divisors is
- ;; exactly equal to the number. For example, the sum of the proper divisors of
- ;; 28 would be 1 + 2 + 4 + 7 + 14 = 28, which means that 28 is a perfect
- ;; number.
- ;;
- ;; A number n is called deficient if the sum of its proper divisors is less
- ;; than n and it is called abundant if this sum exceeds n.
- ;;
- ;; As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the smallest
- ;; number that can be written as the sum of two abundant numbers is 24. By
- ;; mathematical analysis, it can be shown that all integers greater than 28123
- ;; can be written as the sum of two abundant numbers. However, this upper
- ;; limit cannot be reduced any further by analysis even though it is known
- ;; that the greatest number that cannot be expressed as the sum of two
- ;; abundant numbers is less than this limit.
- ;;
- ;; Find the sum of all the positive integers which cannot be written as the
- ;; sum of two abundant numbers.
- (let* ((limit 28123)
- (abundant-numbers
- (make-hash-set :initial-contents
- (remove-if-not #'abundantp (irange 1 limit)))))
- (flet ((abundant-sum-p (n)
- (iterate (for a :in-hashset abundant-numbers)
- (when (hset-contains-p abundant-numbers (- n a))
- (return t)))))
- (sum (remove-if #'abundant-sum-p (irange 1 limit))))))
-
-(defun problem-24 ()
- ;; A permutation is an ordered arrangement of objects. For example, 3124 is
- ;; one possible permutation of the digits 1, 2, 3 and 4. If all of the
- ;; permutations are listed numerically or alphabetically, we call it
- ;; lexicographic order. The lexicographic permutations of 0, 1 and 2 are:
- ;;
- ;; 012 021 102 120 201 210
- ;;
- ;; What is the millionth lexicographic permutation of the digits 0, 1, 2, 3,
- ;; 4, 5, 6, 7, 8 and 9?
- (-<> "0123456789"
- (gathering-vector (:size (factorial (length <>)))
- (map-permutations (compose #'gather #'parse-integer) <>
- :copy nil))
- (sort <> #'<)
- (elt <> (1- 1000000))))
-
-(defun problem-25 ()
- ;; The Fibonacci sequence is defined by the recurrence relation:
- ;;
- ;; Fn = Fn−1 + Fn−2, where F1 = 1 and F2 = 1.
- ;;
- ;; Hence the first 12 terms will be:
- ;;
- ;; F1 = 1
- ;; F2 = 1
- ;; F3 = 2
- ;; F4 = 3
- ;; F5 = 5
- ;; F6 = 8
- ;; F7 = 13
- ;; F8 = 21
- ;; F9 = 34
- ;; F10 = 55
- ;; F11 = 89
- ;; F12 = 144
- ;;
- ;; The 12th term, F12, is the first term to contain three digits.
- ;;
- ;; What is the index of the first term in the Fibonacci sequence to contain
- ;; 1000 digits?
- (iterate (for f :in-fibonacci t)
- (for i :from 1)
- (finding i :such-that (= 1000 (digits-length f)))))
-
-(defun problem-26 ()
- ;; A unit fraction contains 1 in the numerator. The decimal representation of
- ;; the unit fractions with denominators 2 to 10 are given:
- ;;
- ;; 1/2 = 0.5
- ;; 1/3 = 0.(3)
- ;; 1/4 = 0.25
- ;; 1/5 = 0.2
- ;; 1/6 = 0.1(6)
- ;; 1/7 = 0.(142857)
- ;; 1/8 = 0.125
- ;; 1/9 = 0.(1)
- ;; 1/10 = 0.1
- ;;
- ;; Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can
- ;; be seen that 1/7 has a 6-digit recurring cycle.
- ;;
- ;; Find the value of d < 1000 for which 1/d contains the longest recurring
- ;; cycle in its decimal fraction part.
- (iterate
- ;; 2 and 5 are the only primes that aren't coprime to 10
- (for i :in (set-difference (primes-below 1000) '(2 5)))
- (finding i :maximizing (multiplicative-order 10 i))))
-
-(defun problem-27 ()
- ;; Euler discovered the remarkable quadratic formula:
- ;;
- ;; n² + n + 41
- ;;
- ;; It turns out that the formula will produce 40 primes for the consecutive
- ;; integer values 0 ≤ n ≤ 39. However, when n=40, 40² + 40 + 41 = 40(40 + 1)
- ;; + 41 is divisible by 41, and certainly when n=41, 41² + 41 + 41 is clearly
- ;; divisible by 41.
- ;;
- ;; The incredible formula n² − 79n + 1601 was discovered, which produces 80
- ;; primes for the consecutive values 0 ≤ n ≤ 79. The product of the
- ;; coefficients, −79 and 1601, is −126479.
- ;;
- ;; Considering quadratics of the form:
- ;;
- ;; n² + an + b, where |a| < 1000 and |b| ≤ 1000
- ;;
- ;; where |n| is the modulus/absolute value of n
- ;; e.g. |11| = 11 and |−4| = 4
- ;;
- ;; Find the product of the coefficients, a and b, for the quadratic expression
- ;; that produces the maximum number of primes for consecutive values of n,
- ;; starting with n=0.
- (flet ((primes-produced (a b)
- (iterate (for n :from 0)
- (while (primep (+ (square n) (* a n) b)))
- (counting t))))
- (iterate (for-nested ((a :from -999 :to 999)
- (b :from -1000 :to 1000)))
- (finding (* a b) :maximizing (primes-produced a b)))))
-
-(defun problem-28 ()
- ;; Starting with the number 1 and moving to the right in a clockwise direction
- ;; a 5 by 5 spiral is formed as follows:
- ;;
- ;; 21 22 23 24 25
- ;; 20 7 8 9 10
- ;; 19 6 1 2 11
- ;; 18 5 4 3 12
- ;; 17 16 15 14 13
- ;;
- ;; It can be verified that the sum of the numbers on the diagonals is 101.
- ;;
- ;; What is the sum of the numbers on the diagonals in a 1001 by 1001 spiral
- ;; formed in the same way?
- (iterate (for size :from 1 :to 1001 :by 2)
- (summing (apply #'+ (number-spiral-corners size)))))
-
-(defun problem-29 ()
- ;; Consider all integer combinations of a^b for 2 ≤ a ≤ 5 and 2 ≤ b ≤ 5:
- ;;
- ;; 2²=4, 2³=8, 2⁴=16, 2⁵=32
- ;; 3²=9, 3³=27, 3⁴=81, 3⁵=243
- ;; 4²=16, 4³=64, 4⁴=256, 4⁵=1024
- ;; 5²=25, 5³=125, 5⁴=625, 5⁵=3125
- ;;
- ;; If they are then placed in numerical order, with any repeats removed, we
- ;; get the following sequence of 15 distinct terms:
- ;;
- ;; 4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125
- ;;
- ;; How many distinct terms are in the sequence generated by a^b for
- ;; 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?
- (length (iterate (for-nested ((a :from 2 :to 100)
- (b :from 2 :to 100)))
- (adjoining (expt a b)))))
-
-(defun problem-30 ()
- ;; Surprisingly there are only three numbers that can be written as the sum of
- ;; fourth powers of their digits:
- ;;
- ;; 1634 = 1⁴ + 6⁴ + 3⁴ + 4⁴
- ;; 8208 = 8⁴ + 2⁴ + 0⁴ + 8⁴
- ;; 9474 = 9⁴ + 4⁴ + 7⁴ + 4⁴
- ;;
- ;; As 1 = 1⁴ is not a sum it is not included.
- ;;
- ;; The sum of these numbers is 1634 + 8208 + 9474 = 19316.
- ;;
- ;; Find the sum of all the numbers that can be written as the sum of fifth
- ;; powers of their digits.
- (flet ((maximum-sum-for-digits (n)
- (* (expt 9 5) n))
- (digit-power-sum (n)
- (sum (mapcar (rcurry #'expt 5) (digits n)))))
- (iterate
- ;; We want to find a limit N that's bigger than the maximum possible sum
- ;; for its number of digits.
- (with limit = (iterate (for digits :from 1)
- (for n = (expt 10 digits))
- (while (< n (maximum-sum-for-digits digits)))
- (finally (return n))))
- ;; Then just brute-force the thing.
- (for i :from 2 :to limit)
- (when (= i (digit-power-sum i))
- (summing i)))))
-
-(defun problem-31 ()
- ;; In England the currency is made up of pound, £, and pence, p, and there are
- ;; eight coins in general circulation:
- ;;
- ;; 1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) and £2 (200p).
- ;;
- ;; It is possible to make £2 in the following way:
- ;;
- ;; 1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p
- ;;
- ;; How many different ways can £2 be made using any number of coins?
- (recursively ((amount 200)
- (coins '(200 100 50 20 10 5 2 1)))
- (cond
- ((zerop amount) 1)
- ((minusp amount) 0)
- ((null coins) 0)
- (t (+ (recur (- amount (first coins)) coins)
- (recur amount (rest coins)))))))
-
-(defun problem-32 ()
- ;; We shall say that an n-digit number is pandigital if it makes use of all
- ;; the digits 1 to n exactly once; for example, the 5-digit number, 15234, is
- ;; 1 through 5 pandigital.
- ;;
- ;; The product 7254 is unusual, as the identity, 39 × 186 = 7254, containing
- ;; multiplicand, multiplier, and product is 1 through 9 pandigital.
- ;;
- ;; Find the sum of all products whose multiplicand/multiplier/product identity
- ;; can be written as a 1 through 9 pandigital.
- ;;
- ;; HINT: Some products can be obtained in more than one way so be sure to only
- ;; include it once in your sum.
- (labels ((split (digits a b)
- (values (digits-to-number (subseq digits 0 a))
- (digits-to-number (subseq digits a (+ a b)))
- (digits-to-number (subseq digits (+ a b)))))
- (check (digits a b)
- (multiple-value-bind (a b c)
- (split digits a b)
- (when (= (* a b) c)
- c))))
- (-<> (gathering
- (map-permutations (lambda (digits)
- (let ((c1 (check digits 3 2))
- (c2 (check digits 4 1)))
- (when c1 (gather c1))
- (when c2 (gather c2))))
- #(1 2 3 4 5 6 7 8 9)
- :copy nil))
- remove-duplicates
- sum)))
-
-(defun problem-33 ()
- ;; The fraction 49/98 is a curious fraction, as an inexperienced mathematician
- ;; in attempting to simplify it may incorrectly believe that 49/98 = 4/8,
- ;; which is correct, is obtained by cancelling the 9s.
- ;;
- ;; We shall consider fractions like, 30/50 = 3/5, to be trivial examples.
- ;;
- ;; There are exactly four non-trivial examples of this type of fraction, less
- ;; than one in value, and containing two digits in the numerator and
- ;; denominator.
- ;;
- ;; If the product of these four fractions is given in its lowest common terms,
- ;; find the value of the denominator.
- (labels ((safe/ (a b)
- (unless (zerop b) (/ a b)))
- (cancel (digit other digits)
- (destructuring-bind (x y) digits
- (remove nil (list (when (= digit x) (safe/ other y))
- (when (= digit y) (safe/ other x))))))
- (cancellations (numerator denominator)
- (let ((nd (digits numerator))
- (dd (digits denominator)))
- (append (cancel (first nd) (second nd) dd)
- (cancel (second nd) (first nd) dd))))
- (curiousp (numerator denominator)
- (member (/ numerator denominator)
- (cancellations numerator denominator)))
- (trivialp (numerator denominator)
- (and (dividesp numerator 10)
- (dividesp denominator 10))))
- (iterate
- (with result = 1)
- (for numerator :from 10 :to 99)
- (iterate (for denominator :from (1+ numerator) :to 99)
- (when (and (curiousp numerator denominator)
- (not (trivialp numerator denominator)))
- (mulf result (/ numerator denominator))))
- (finally (return (denominator result))))))
-
-(defun problem-34 ()
- ;; 145 is a curious number, as 1! + 4! + 5! = 1 + 24 + 120 = 145.
- ;;
- ;; Find the sum of all numbers which are equal to the sum of the factorial of
- ;; their digits.
- ;;
- ;; Note: as 1! = 1 and 2! = 2 are not sums they are not included.
- (iterate
- (for n :from 3 :to 1000000)
- ;; have to use funcall here because `sum` is an iterate keyword. kill me.
- (when (= n (funcall #'sum (digits n) :key #'factorial))
- (summing n))))
-
-(defun problem-35 ()
- ;; The number, 197, is called a circular prime because all rotations of the
- ;; digits: 197, 971, and 719, are themselves prime.
- ;;
- ;; There are thirteen such primes below 100: 2, 3, 5, 7, 11, 13, 17, 31, 37,
- ;; 71, 73, 79, and 97.
- ;;
- ;; How many circular primes are there below one million?
- (labels ((rotate (n distance)
- (multiple-value-bind (hi lo)
- (truncate n (expt 10 distance))
- (+ (* (expt 10 (digits-length hi)) lo)
- hi)))
- (rotations (n)
- (mapcar (curry #'rotate n) (range 1 (digits-length n))))
- (circular-prime-p (n)
- (every #'primep (rotations n))))
- (iterate (for i :in-vector (sieve 1000000))
- (counting (circular-prime-p i)))))
-
-(defun problem-36 ()
- ;; The decimal number, 585 = 1001001001 (binary), is palindromic in both
- ;; bases.
- ;;
- ;; Find the sum of all numbers, less than one million, which are palindromic
- ;; in base 10 and base 2.
- ;;
- ;; (Please note that the palindromic number, in either base, may not include
- ;; leading zeros.)
- (iterate (for i :from 1 :below 1000000)
- (when (and (palindromep i 10)
- (palindromep i 2))
- (sum i))))
-
-(defun problem-37 ()
- ;; The number 3797 has an interesting property. Being prime itself, it is
- ;; possible to continuously remove digits from left to right, and remain prime
- ;; at each stage: 3797, 797, 97, and 7. Similarly we can work from right to
- ;; left: 3797, 379, 37, and 3.
- ;;
- ;; Find the sum of the only eleven primes that are both truncatable from left
- ;; to right and right to left.
- ;;
- ;; NOTE: 2, 3, 5, and 7 are not considered to be truncatable primes.
- (labels ((truncations (n)
- (iterate (for i :from 0 :below (digits-length n))
- (collect (truncate-number-left n i))
- (collect (truncate-number-right n i))))
- (truncatablep (n)
- (every #'primep (truncations n))))
- (iterate
- (with count = 0)
- (for i :from 11 :by 2)
- (when (truncatablep i)
- (sum i)
- (incf count))
- (while (< count 11)))))
-
-(defun problem-38 ()
- ;; Take the number 192 and multiply it by each of 1, 2, and 3:
- ;;
- ;; 192 × 1 = 192
- ;; 192 × 2 = 384
- ;; 192 × 3 = 576
- ;;
- ;; By concatenating each product we get the 1 to 9 pandigital, 192384576. We
- ;; will call 192384576 the concatenated product of 192 and (1,2,3)
- ;;
- ;; The same can be achieved by starting with 9 and multiplying by 1, 2, 3, 4,
- ;; and 5, giving the pandigital, 918273645, which is the concatenated product
- ;; of 9 and (1,2,3,4,5).
- ;;
- ;; What is the largest 1 to 9 pandigital 9-digit number that can be formed as
- ;; the concatenated product of an integer with (1,2, ... , n) where n > 1?
- (labels ((concatenated-product (number i)
- (apply #'concatenate-integers
- (iterate (for n :from 1 :to i)
- (collect (* number n))))))
- (iterate
- main
- (for base :from 1)
- ;; base can't be more than 5 digits long because we have to concatenate at
- ;; least two products of it
- (while (digits<= base 5))
- (iterate (for n :from 2)
- (for result = (concatenated-product base n))
- ;; result is only ever going to grow larger, so once we pass the
- ;; nine digit mark we can stop
- (while (digits<= result 9))
- (when (pandigitalp result)
- (in main (maximizing result)))))))
-
-(defun problem-39 ()
- ;; If p is the perimeter of a right angle triangle with integral length sides,
- ;; {a,b,c}, there are exactly three solutions for p = 120.
- ;;
- ;; {20,48,52}, {24,45,51}, {30,40,50}
- ;;
- ;; For which value of p ≤ 1000, is the number of solutions maximised?
- (iterate
- (for p :from 1 :to 1000)
- (finding p :maximizing (length (pythagorean-triplets-of-perimeter p)))))
-
-(defun problem-40 ()
- ;; An irrational decimal fraction is created by concatenating the positive
- ;; integers:
- ;;
- ;; 0.123456789101112131415161718192021...
- ;;
- ;; It can be seen that the 12th digit of the fractional part is 1.
- ;;
- ;; If dn represents the nth digit of the fractional part, find the value of
- ;; the following expression.
- ;;
- ;; d1 × d10 × d100 × d1000 × d10000 × d100000 × d1000000
- (iterate
- top
- (with index = 0)
- (for digits :key #'digits :from 1)
- (iterate (for d :in digits)
- (incf index)
- (when (member index '(1 10 100 1000 10000 100000 1000000))
- (in top (multiplying d))
- (when (= index 1000000)
- (in top (terminate)))))))
-
-(defun problem-41 ()
- ;; We shall say that an n-digit number is pandigital if it makes use of all
- ;; the digits 1 to n exactly once. For example, 2143 is a 4-digit pandigital
- ;; and is also prime.
- ;;
- ;; What is the largest n-digit pandigital prime that exists?
- (iterate
- ;; There's a clever observation which reduces the upper bound from 9 to
- ;; 7 from "gamma" in the forum:
- ;;
- ;; > Note: Nine numbers cannot be done (1+2+3+4+5+6+7+8+9=45 => always dividable by 3)
- ;; > Note: Eight numbers cannot be done (1+2+3+4+5+6+7+8=36 => always dividable by 3)
- (for n :downfrom 7)
- (thereis (apply (nullary #'max)
- (remove-if-not #'primep (pandigitals 1 n))))))
-
-(defun problem-42 ()
- ;; The nth term of the sequence of triangle numbers is given by, tn = ½n(n+1);
- ;; so the first ten triangle numbers are:
- ;;
- ;; 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
- ;;
- ;; By converting each letter in a word to a number corresponding to its
- ;; alphabetical position and adding these values we form a word value. For
- ;; example, the word value for SKY is 19 + 11 + 25 = 55 = t10. If the word
- ;; value is a triangle number then we shall call the word a triangle word.
- ;;
- ;; Using words.txt (right click and 'Save Link/Target As...'), a 16K text file
- ;; containing nearly two-thousand common English words, how many are triangle
- ;; words?
- (labels ((word-value (word)
- (sum word :key #'letter-number))
- (triangle-word-p (word)
- (trianglep (word-value word))))
- (count-if #'triangle-word-p (parse-strings-file "data/42-words.txt"))))
-
-(defun problem-43 ()
- ;; The number, 1406357289, is a 0 to 9 pandigital number because it is made up
- ;; of each of the digits 0 to 9 in some order, but it also has a rather
- ;; interesting sub-string divisibility property.
- ;;
- ;; Let d1 be the 1st digit, d2 be the 2nd digit, and so on. In this way, we
- ;; note the following:
- ;;
- ;; d2d3d4=406 is divisible by 2
- ;; d3d4d5=063 is divisible by 3
- ;; d4d5d6=635 is divisible by 5
- ;; d5d6d7=357 is divisible by 7
- ;; d6d7d8=572 is divisible by 11
- ;; d7d8d9=728 is divisible by 13
- ;; d8d9d10=289 is divisible by 17
- ;;
- ;; Find the sum of all 0 to 9 pandigital numbers with this property.
- (labels ((extract3 (digits start)
- (digits-to-number (subseq digits start (+ 3 start))))
- (interestingp (n)
- (let ((digits (digits n)))
- ;; eat shit mathematicians, indexes start from zero
- (and (dividesp (extract3 digits 1) 2)
- (dividesp (extract3 digits 2) 3)
- (dividesp (extract3 digits 3) 5)
- (dividesp (extract3 digits 4) 7)
- (dividesp (extract3 digits 5) 11)
- (dividesp (extract3 digits 6) 13)
- (dividesp (extract3 digits 7) 17)))))
- (sum (remove-if-not #'interestingp (pandigitals 0 9)))))
-
-(defun problem-44 ()
- ;; Pentagonal numbers are generated by the formula, Pn=n(3n−1)/2. The first
- ;; ten pentagonal numbers are:
- ;;
- ;; 1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ...
- ;;
- ;; It can be seen that P4 + P7 = 22 + 70 = 92 = P8. However, their difference,
- ;; 70 − 22 = 48, is not pentagonal.
- ;;
- ;; Find the pair of pentagonal numbers, Pj and Pk, for which their sum and
- ;; difference are pentagonal and D = |Pk − Pj| is minimised; what is the value
- ;; of D?
- (flet ((interestingp (px py)
- (and (pentagonp (+ py px))
- (pentagonp (- py px)))))
- (iterate
- (with result = most-positive-fixnum) ; my kingdom for `CL:INFINITY`
- (for y :from 2)
- (for z :from 3)
- (for py = (pentagon y))
- (for pz = (pentagon z))
- (when (>= (- pz py) result)
- (return result))
- (iterate
- (for x :from (1- y) :downto 1)
- (for px = (pentagon x))
- (when (interestingp px py)
- (let ((distance (- py px)))
- (when (< distance result)
- ;; TODO: This isn't quite right, because this is just the FIRST
- ;; number we find -- we haven't guaranteed that it's the SMALLEST
- ;; one we'll ever see. But it happens to accidentally be the
- ;; correct one, and until I get around to rewriting this with
- ;; priority queues it'll have to do.
- (return-from problem-44 distance)))
- (return))))))
-
-(defun problem-45 ()
- ;; Triangle, pentagonal, and hexagonal numbers are generated by the following
- ;; formulae:
- ;;
- ;; Triangle Tn=n(n+1)/2 1, 3, 6, 10, 15, ...
- ;; Pentagonal Pn=n(3n−1)/2 1, 5, 12, 22, 35, ...
- ;; Hexagonal Hn=n(2n−1) 1, 6, 15, 28, 45, ...
- ;;
- ;; It can be verified that T285 = P165 = H143 = 40755.
- ;;
- ;; Find the next triangle number that is also pentagonal and hexagonal.
- (iterate
- (for n :key #'triangle :from 286)
- (finding n :such-that (and (pentagonp n) (hexagonp n)))))
-
-(defun problem-46 ()
- ;; It was proposed by Christian Goldbach that every odd composite number can
- ;; be written as the sum of a prime and twice a square.
- ;;
- ;; 9 = 7 + 2×1²
- ;; 15 = 7 + 2×2²
- ;; 21 = 3 + 2×3²
- ;; 25 = 7 + 2×3²
- ;; 27 = 19 + 2×2²
- ;; 33 = 31 + 2×1²
- ;;
- ;; It turns out that the conjecture was false.
- ;;
- ;; What is the smallest odd composite that cannot be written as the sum of
- ;; a prime and twice a square?
- (flet ((counterexamplep (n)
- (iterate
- (for prime :in-vector (sieve n))
- (never (squarep (/ (- n prime) 2))))))
- (iterate
- (for i :from 1 :by 2)
- (finding i :such-that (and (compositep i)
- (counterexamplep i))))))
-
-(defun problem-47 ()
- ;; The first two consecutive numbers to have two distinct prime factors are:
- ;;
- ;; 14 = 2 × 7
- ;; 15 = 3 × 5
- ;;
- ;; The first three consecutive numbers to have three distinct prime factors are:
- ;;
- ;; 644 = 2² × 7 × 23
- ;; 645 = 3 × 5 × 43
- ;; 646 = 2 × 17 × 19
- ;;
- ;; Find the first four consecutive integers to have four distinct prime
- ;; factors each. What is the first of these numbers?
- (flet ((factor-count (n)
- (length (remove-duplicates (prime-factorization n)))))
- (iterate
- (with run = 0)
- (for i :from 1)
- (if (= 4 (factor-count i))
- (incf run)
- (setf run 0))
- (finding (- i 3) :such-that (= run 4)))))
-
-(defun problem-48 ()
- ;; The series, 1^1 + 2^2 + 3^3 + ... + 10^10 = 10405071317.
- ;;
- ;; Find the last ten digits of the series, 1^1 + 2^2 + 3^3 + ... + 1000^1000.
- (-<> (irange 1 1000)
- (mapcar #'expt <> <>)
- sum
- (mod <> (expt 10 10))))
-
-(defun problem-49 ()
- ;; The arithmetic sequence, 1487, 4817, 8147, in which each of the terms
- ;; increases by 3330, is unusual in two ways: (i) each of the three terms are
- ;; prime, and, (ii) each of the 4-digit numbers are permutations of one
- ;; another.
- ;;
- ;; There are no arithmetic sequences made up of three 1-, 2-, or 3-digit
- ;; primes, exhibiting this property, but there is one other 4-digit increasing
- ;; sequence.
- ;;
- ;; What 12-digit number do you form by concatenating the three terms in this
- ;; sequence?
- (labels ((permutation= (a b)
- (orderless-equal (digits a) (digits b)))
- (length>=3 (list)
- (>= (length list) 3))
- (arithmetic-sequence-p (seq)
- (apply #'= (mapcar (curry #'apply #'-)
- (n-grams 2 seq))))
- (has-arithmetic-sequence-p (seq)
- (map-combinations
- (lambda (s)
- (when (arithmetic-sequence-p s)
- (return-from has-arithmetic-sequence-p s)))
- (sort seq #'<)
- :length 3)
- nil))
- (-<> (primes-in 1000 9999)
- (equivalence-classes #'permutation= <>) ; find all permutation groups
- (remove-if-not #'length>=3 <>) ; make sure they have at leat 3 elements
- (mapcar #'has-arithmetic-sequence-p <>)
- (remove nil <>)
- (remove-if (lambda (s) (= (first s) 1487)) <>) ; remove the example
- first
- (mapcan #'digits <>)
- digits-to-number)))
-
-(defun problem-50 ()
- ;; The prime 41, can be written as the sum of six consecutive primes:
- ;;
- ;; 41 = 2 + 3 + 5 + 7 + 11 + 13
- ;;
- ;; This is the longest sum of consecutive primes that adds to a prime below
- ;; one-hundred.
- ;;
- ;; The longest sum of consecutive primes below one-thousand that adds to
- ;; a prime, contains 21 terms, and is equal to 953.
- ;;
- ;; Which prime, below one-million, can be written as the sum of the most
- ;; consecutive primes?
- (let ((primes (sieve 1000000)))
- (flet ((score (start)
- (iterate
- (with score = 0)
- (with winner = 0)
- (for run :from 1)
- (for prime :in-vector primes :from start)
- (summing prime :into sum)
- (while (< sum 1000000))
- (when (primep sum)
- (setf score run
- winner sum))
- (finally (return (values score winner))))))
- (iterate
- (for (values score winner)
- :key #'score :from 0 :below (length primes))
- (finding winner :maximizing score)))))
-
-(defun problem-51 ()
- ;; By replacing the 1st digit of the 2-digit number *3, it turns out that six
- ;; of the nine possible values: 13, 23, 43, 53, 73, and 83, are all prime.
- ;;
- ;; By replacing the 3rd and 4th digits of 56**3 with the same digit, this
- ;; 5-digit number is the first example having seven primes among the ten
- ;; generated numbers, yielding the family: 56003, 56113, 56333, 56443, 56663,
- ;; 56773, and 56993. Consequently 56003, being the first member of this
- ;; family, is the smallest prime with this property.
- ;;
- ;; Find the smallest prime which, by replacing part of the number (not
- ;; necessarily adjacent digits) with the same digit, is part of an eight prime
- ;; value family.
- (labels
- ((patterns (prime)
- (iterate (with size = (digits-length prime))
- (with indices = (range 0 size))
- (for i :from 1 :below size)
- (appending (combinations indices :length i))))
- (apply-pattern-digit (prime pattern new-digit)
- (iterate (with result = (digits prime))
- (for index :in pattern)
- (when (and (zerop index) (zerop new-digit))
- (leave))
- (setf (nth index result) new-digit)
- (finally (return (digits-to-number result)))))
- (apply-pattern (prime pattern)
- (iterate (for digit in (irange 0 9))
- (for result = (apply-pattern-digit prime pattern digit))
- (when (and result (primep result))
- (collect result))))
- (apply-patterns (prime)
- (mapcar (curry #'apply-pattern prime) (patterns prime)))
- (winnerp (prime)
- (find-if (curry #'length= 8) (apply-patterns prime))))
- (-<> (iterate (for i :from 3 :by 2)
- (thereis (and (primep i) (winnerp i))))
- (sort< <>)
- first)))
-
-(defun problem-52 ()
- ;; It can be seen that the number, 125874, and its double, 251748, contain
- ;; exactly the same digits, but in a different order.
- ;;
- ;; Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x,
- ;; contain the same digits.
- (iterate (for i :from 1)
- (for digits = (digits i))
- (finding i :such-that
- (every (lambda (n)
- (orderless-equal digits (digits (* n i))))
- '(2 3 4 5 6)))))
-
-(defun problem-53 ()
- ;; There are exactly ten ways of selecting three from five, 12345:
- ;;
- ;; 123, 124, 125, 134, 135, 145, 234, 235, 245, and 345
- ;;
- ;; In combinatorics, we use the notation, 5C3 = 10.
- ;;
- ;; In general,
- ;;
- ;; nCr = n! / r!(n−r)!
- ;;
- ;; where r ≤ n, n! = n×(n−1)×...×3×2×1, and 0! = 1.
- ;;
- ;; It is not until n = 23, that a value exceeds one-million: 23C10 = 1144066.
- ;;
- ;; How many, not necessarily distinct, values of nCr, for 1 ≤ n ≤ 100, are
- ;; greater than one-million?
- (iterate
- main
- (for n :from 1 :to 100)
- (iterate
- (for r :from 1 :to n)
- (for nCr = (binomial-coefficient n r))
- (in main (counting (> nCr 1000000))))))
-
-(defun problem-54 ()
- ;; In the card game poker, a hand consists of five cards and are ranked, from
- ;; lowest to highest, in the following way:
- ;;
- ;; High Card: Highest value card.
- ;; One Pair: Two cards of the same value.
- ;; Two Pairs: Two different pairs.
- ;; Three of a Kind: Three cards of the same value.
- ;; Straight: All cards are consecutive values.
- ;; Flush: All cards of the same suit.
- ;; Full House: Three of a kind and a pair.
- ;; Four of a Kind: Four cards of the same value.
- ;; Straight Flush: All cards are consecutive values of same suit.
- ;; Royal Flush: Ten, Jack, Queen, King, Ace, in same suit.
- ;;
- ;; The cards are valued in the order:
- ;; 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace.
- ;;
- ;; If two players have the same ranked hands then the rank made up of the
- ;; highest value wins; for example, a pair of eights beats a pair of fives
- ;; (see example 1 below). But if two ranks tie, for example, both players have
- ;; a pair of queens, then highest cards in each hand are compared (see example
- ;; 4 below); if the highest cards tie then the next highest cards are
- ;; compared, and so on.
- ;;
- ;; The file, poker.txt, contains one-thousand random hands dealt to two
- ;; players. Each line of the file contains ten cards (separated by a single
- ;; space): the first five are Player 1's cards and the last five are Player
- ;; 2's cards. You can assume that all hands are valid (no invalid characters
- ;; or repeated cards), each player's hand is in no specific order, and in each
- ;; hand there is a clear winner.
- ;;
- ;; How many hands does Player 1 win?
- (iterate (for line :in-file "data/54-poker.txt" :using #'read-line)
- (for cards = (mapcar #'euler.poker::parse-card
- (cl-strings:split line #\space)))
- (for p1 = (take 5 cards))
- (for p2 = (drop 5 cards))
- (counting (euler.poker::poker-hand-beats-p p1 p2))))
-
-(defun problem-55 ()
- ;; If we take 47, reverse and add, 47 + 74 = 121, which is palindromic.
- ;;
- ;; Not all numbers produce palindromes so quickly. For example,
- ;;
- ;; 349 + 943 = 1292,
- ;; 1292 + 2921 = 4213
- ;; 4213 + 3124 = 7337
- ;;
- ;; That is, 349 took three iterations to arrive at a palindrome.
- ;;
- ;; Although no one has proved it yet, it is thought that some numbers, like
- ;; 196, never produce a palindrome. A number that never forms a palindrome
- ;; through the reverse and add process is called a Lychrel number. Due to the
- ;; theoretical nature of these numbers, and for the purpose of this problem,
- ;; we shall assume that a number is Lychrel until proven otherwise. In
- ;; addition you are given that for every number below ten-thousand, it will
- ;; either (i) become a palindrome in less than fifty iterations, or, (ii) no
- ;; one, with all the computing power that exists, has managed so far to map it
- ;; to a palindrome. In fact, 10677 is the first number to be shown to require
- ;; over fifty iterations before producing a palindrome:
- ;; 4668731596684224866951378664 (53 iterations, 28-digits).
- ;;
- ;; Surprisingly, there are palindromic numbers that are themselves Lychrel
- ;; numbers; the first example is 4994.
- ;;
- ;; How many Lychrel numbers are there below ten-thousand?
- (labels ((lychrel (n)
- (+ n (reverse-integer n)))
- (lychrelp (n)
- (iterate
- (repeat 50)
- (for i :iterating #'lychrel :seed n)
- (never (palindromep i)))))
- (iterate (for i :from 0 :below 10000)
- (counting (lychrelp i)))))
-
-(defun problem-56 ()
- ;; A googol (10^100) is a massive number: one followed by one-hundred zeros;
- ;; 100^100 is almost unimaginably large: one followed by two-hundred zeros.
- ;; Despite their size, the sum of the digits in each number is only 1.
- ;;
- ;; Considering natural numbers of the form, a^b, where a, b < 100, what is the
- ;; maximum digital sum?
- (iterate (for-nested ((a :from 1 :below 100)
- (b :from 1 :below 100)))
- (maximizing (funcall #'sum (digits (expt a b))))))
-
-(defun problem-57 ()
- ;; It is possible to show that the square root of two can be expressed as an
- ;; infinite continued fraction.
- ;;
- ;; √ 2 = 1 + 1/(2 + 1/(2 + 1/(2 + ... ))) = 1.414213...
- ;;
- ;; By expanding this for the first four iterations, we get:
- ;;
- ;; 1 + 1/2 = 3/2 = 1.5
- ;; 1 + 1/(2 + 1/2) = 7/5 = 1.4
- ;; 1 + 1/(2 + 1/(2 + 1/2)) = 17/12 = 1.41666...
- ;; 1 + 1/(2 + 1/(2 + 1/(2 + 1/2))) = 41/29 = 1.41379...
- ;;
- ;; The next three expansions are 99/70, 239/169, and 577/408, but the eighth
- ;; expansion, 1393/985, is the first example where the number of digits in the
- ;; numerator exceeds the number of digits in the denominator.
- ;;
- ;; In the first one-thousand expansions, how many fractions contain
- ;; a numerator with more digits than denominator?
- (iterate
- (repeat 1000)
- (for i :initially 1/2 :then (/ (+ 2 i)))
- (for expansion = (1+ i))
- (counting (> (digits-length (numerator expansion))
- (digits-length (denominator expansion))))))
-
-(defun problem-58 ()
- ;; Starting with 1 and spiralling anticlockwise in the following way, a square
- ;; spiral with side length 7 is formed.
- ;;
- ;; 37 36 35 34 33 32 31
- ;; 38 17 16 15 14 13 30
- ;; 39 18 5 4 3 12 29
- ;; 40 19 6 1 2 11 28
- ;; 41 20 7 8 9 10 27
- ;; 42 21 22 23 24 25 26
- ;; 43 44 45 46 47 48 49
- ;;
- ;; It is interesting to note that the odd squares lie along the bottom right
- ;; diagonal, but what is more interesting is that 8 out of the 13 numbers
- ;; lying along both diagonals are prime; that is, a ratio of 8/13 ≈ 62%.
- ;;
- ;; If one complete new layer is wrapped around the spiral above, a square
- ;; spiral with side length 9 will be formed. If this process is continued,
- ;; what is the side length of the square spiral for which the ratio of primes
- ;; along both diagonals first falls below 10%?
- (labels ((score (value)
- (if (primep value) 1 0))
- (primes-in-layer (size)
- (sum (number-spiral-corners size) :key #'score)))
- (iterate
- (for size :from 3 :by 2)
- (for count :from 5 :by 4)
- (sum (primes-in-layer size) :into primes)
- (for ratio = (/ primes count))
- (finding size :such-that (< ratio 1/10)))))
-
-(defun problem-59 ()
- ;; Each character on a computer is assigned a unique code and the preferred
- ;; standard is ASCII (American Standard Code for Information Interchange).
- ;; For example, uppercase A = 65, asterisk (*) = 42, and lowercase k = 107.
- ;;
- ;; A modern encryption method is to take a text file, convert the bytes to
- ;; ASCII, then XOR each byte with a given value, taken from a secret key. The
- ;; advantage with the XOR function is that using the same encryption key on
- ;; the cipher text, restores the plain text; for example, 65 XOR 42 = 107,
- ;; then 107 XOR 42 = 65.
- ;;
- ;; For unbreakable encryption, the key is the same length as the plain text
- ;; message, and the key is made up of random bytes. The user would keep the
- ;; encrypted message and the encryption key in different locations, and
- ;; without both "halves", it is impossible to decrypt the message.
- ;;
- ;; Unfortunately, this method is impractical for most users, so the modified
- ;; method is to use a password as a key. If the password is shorter than the
- ;; message, which is likely, the key is repeated cyclically throughout the
- ;; message. The balance for this method is using a sufficiently long password
- ;; key for security, but short enough to be memorable.
- ;;
- ;; Your task has been made easy, as the encryption key consists of three lower
- ;; case characters. Using cipher.txt (right click and 'Save Link/Target
- ;; As...'), a file containing the encrypted ASCII codes, and the knowledge
- ;; that the plain text must contain common English words, decrypt the message
- ;; and find the sum of the ASCII values in the original text.
- (let* ((data (-<> "data/59-cipher.txt"
- read-file-into-string
- (substitute #\space #\, <>)
- read-all-from-string))
- (raw-words (-<> "/usr/share/dict/words"
- read-file-into-string
- (cl-strings:split <> #\newline)
- (mapcar #'string-downcase <>)))
- (words (make-hash-set :test 'equal :initial-contents raw-words)))
- (labels
- ((stringify (codes)
- (map 'string #'code-char codes))
- (apply-cipher (key)
- (iterate (for number :in data)
- (for k :in-looping key)
- (collect (logxor number k))))
- (score-keyword (keyword)
- (-<> (apply-cipher keyword)
- (stringify <>)
- (string-downcase <>)
- (cl-strings:split <>)
- (remove-if-not (curry #'hset-contains-p words) <>)
- length))
- (answer (keyword)
- ;; (pr (stringify keyword)) ; keyword is "god", lol
- (sum (apply-cipher keyword))))
- (iterate (for-nested ((a :from (char-code #\a) :to (char-code #\z))
- (b :from (char-code #\a) :to (char-code #\z))
- (c :from (char-code #\a) :to (char-code #\z))))
- (for keyword = (list a b c))
- (finding (answer keyword) :maximizing (score-keyword keyword))))))
-
-(defun problem-60 ()
- ;; The primes 3, 7, 109, and 673, are quite remarkable. By taking any two
- ;; primes and concatenating them in any order the result will always be prime.
- ;; For example, taking 7 and 109, both 7109 and 1097 are prime. The sum of
- ;; these four primes, 792, represents the lowest sum for a set of four primes
- ;; with this property.
- ;;
- ;; Find the lowest sum for a set of five primes for which any two primes
- ;; concatenate to produce another prime.
- (labels-memoized ((concatenates-prime-p (a b)
- (and (primep (concatenate-integers a b))
- (primep (concatenate-integers b a)))))
- (flet ((satisfiesp (prime primes)
- (every (curry #'concatenates-prime-p prime) primes)))
- (iterate
- main
- ;; 2 can never be part of the winning set, because if you concatenate it
- ;; in the last position you get an even number.
- (with primes = (subseq (sieve 10000) 1))
- (for a :in-vector primes :with-index ai)
- (iterate
- (for b :in-vector primes :with-index bi :from (1+ ai))
- (when (satisfiesp b (list a))
- (iterate
- (for c :in-vector primes :with-index ci :from (1+ bi))
- (when (satisfiesp c (list a b))
- (iterate
- (for d :in-vector primes :with-index di :from (1+ ci))
- (when (satisfiesp d (list a b c))
- (iterate
- (for e :in-vector primes :from (1+ di))
- (when (satisfiesp e (list a b c d))
- (in main (return-from problem-60 (+ a b c d e)))))))))))))))
-
-(defun problem-61 ()
- ;; Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers
- ;; are all figurate (polygonal) numbers and are generated by the following
- ;; formulae:
- ;;
- ;; Triangle P3,n=n(n+1)/2 1, 3, 6, 10, 15, ...
- ;; Square P4,n=n² 1, 4, 9, 16, 25, ...
- ;; Pentagonal P5,n=n(3n−1)/2 1, 5, 12, 22, 35, ...
- ;; Hexagonal P6,n=n(2n−1) 1, 6, 15, 28, 45, ...
- ;; Heptagonal P7,n=n(5n−3)/2 1, 7, 18, 34, 55, ...
- ;; Octagonal P8,n=n(3n−2) 1, 8, 21, 40, 65, ...
- ;;
- ;; The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three
- ;; interesting properties.
- ;;
- ;; 1. The set is cyclic, in that the last two digits of each number is the
- ;; first two digits of the next number (including the last number with the
- ;; first).
- ;; 2. Each polygonal type: triangle (P3,127=8128), square (P4,91=8281), and
- ;; pentagonal (P5,44=2882), is represented by a different number in the
- ;; set.
- ;; 3. This is the only set of 4-digit numbers with this property.
- ;;
- ;; Find the sum of the only ordered set of six cyclic 4-digit numbers for
- ;; which each polygonal type: triangle, square, pentagonal, hexagonal,
- ;; heptagonal, and octagonal, is represented by a different number in the set.
- (labels ((numbers (generator)
- (iterate (for i :from 1)
- (for n = (funcall generator i))
- (while (<= n 9999))
- (when (>= n 1000)
- (collect n))))
- (split (number)
- (truncate number 100))
- (prefix (number)
- (when number
- (nth-value 0 (split number))))
- (suffix (number)
- (when number
- (nth-value 1 (split number))))
- (matches (prefix suffix number)
- (multiple-value-bind (p s)
- (split number)
- (and (or (not prefix)
- (= prefix p))
- (or (not suffix)
- (= suffix s)))))
- (choose (numbers used prefix &optional suffix)
- (-<> numbers
- (remove-if-not (curry #'matches prefix suffix) <>)
- (set-difference <> used)))
- (search-sets (sets)
- (recursively ((sets sets)
- (path nil))
- (destructuring-bind (set . remaining) sets
- (if remaining
- ;; We're somewhere in the middle, recur on any number whose
- ;; prefix matches the suffix of the previous element.
- (iterate
- (for number :in (choose set path (suffix (car path))))
- (recur remaining (cons number path)))
- ;; We're on the last set, we need to find a number that fits
- ;; between the penultimate element and first element to
- ;; complete the cycle.
- (when-let*
- ((init (first (last path)))
- (prev (car path))
- (final (choose set path (suffix prev) (prefix init))))
- (return-from problem-61
- (sum (reverse (cons (first final) path))))))))))
- (map-permutations #'search-sets
- (list (numbers #'triangle)
- (numbers #'square)
- (numbers #'pentagon)
- (numbers #'hexagon)
- (numbers #'heptagon)
- (numbers #'octagon)))))
-
-(defun problem-62 ()
- ;; The cube, 41063625 (345³), can be permuted to produce two other cubes:
- ;; 56623104 (384³) and 66430125 (405³). In fact, 41063625 is the smallest cube
- ;; which has exactly three permutations of its digits which are also cube.
- ;;
- ;; Find the smallest cube for which exactly five permutations of its digits
- ;; are cube.
- (let ((scores (make-hash-table))) ; canonical-repr => (count . first-cube)
- ;; Basic strategy from [1] but with some bug fixes. His strategy happens to
- ;; work for this specific case, but could be incorrect for others.
- ;;
- ;; We can't just return as soon as we hit the 5th cubic permutation, because
- ;; what if this cube is actually part of a family of 6? Instead we need to
- ;; check all other cubes with the same number of digits before making a
- ;; final decision to be sure we don't get fooled.
- ;;
- ;; [1]: http://www.mathblog.dk/project-euler-62-cube-five-permutations/
- (labels ((canonicalize (cube)
- (digits-to-number (sort (digits cube) #'>)))
- (mark (cube)
- (let ((entry (ensure-gethash (canonicalize cube) scores
- (cons 0 cube))))
- (incf (car entry))
- entry)))
- (iterate
- (with i = 1)
- (with target = 5)
- (with candidates = nil)
- (for limit :initially 10 :then (* 10 limit))
- (iterate
- (for cube = (cube i))
- (while (< cube limit))
- (incf i)
- (for (score . first) = (mark cube))
- (cond ((= score target) (push first candidates))
- ((> score target) (removef candidates first)))) ; tricksy hobbitses
- (thereis (apply (nullary #'min) candidates))))))
-
-(defun problem-63 ()
- ;; The 5-digit number, 16807=7^5, is also a fifth power. Similarly, the
- ;; 9-digit number, 134217728=8^9, is a ninth power.
- ;;
- ;; How many n-digit positive integers exist which are also an nth power?
- (flet ((score (n)
- ;; 10^n will have n+1 digits, so we never need to check beyond that
- (iterate (for base :from 1 :below 10)
- (for value = (expt base n))
- (counting (= n (digits-length value)))))
- (find-bound ()
- ;; it's 21.something, but I don't really grok why yet
- (iterate
- (for power :from 1)
- (for maximum-possible-digits = (digits-length (expt 9 power)))
- (while (>= maximum-possible-digits power))
- (finally (return power)))))
- (iterate (for n :from 1 :below (find-bound))
- (sum (score n)))))
-
-(defun problem-74 ()
- ;; The number 145 is well known for the property that the sum of the factorial
- ;; of its digits is equal to 145:
- ;;
- ;; 1! + 4! + 5! = 1 + 24 + 120 = 145
- ;;
- ;; Perhaps less well known is 169, in that it produces the longest chain of
- ;; numbers that link back to 169; it turns out that there are only three such
- ;; loops that exist:
- ;;
- ;; 169 → 363601 → 1454 → 169
- ;; 871 → 45361 → 871
- ;; 872 → 45362 → 872
- ;;
- ;; It is not difficult to prove that EVERY starting number will eventually get
- ;; stuck in a loop. For example,
- ;;
- ;; 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
- ;; 78 → 45360 → 871 → 45361 (→ 871)
- ;; 540 → 145 (→ 145)
- ;;
- ;; Starting with 69 produces a chain of five non-repeating terms, but the
- ;; longest non-repeating chain with a starting number below one million is
- ;; sixty terms.
- ;;
- ;; How many chains, with a starting number below one million, contain exactly
- ;; sixty non-repeating terms?
- (labels ((digit-factorial (n)
- (sum (mapcar #'factorial (digits n))))
- (term-count (n)
- (iterate (for i :initially n :then (digit-factorial i))
- (until (member i prev))
- (collect i :into prev)
- (counting t))))
- (iterate (for i :from 1 :below 1000000)
- (counting (= 60 (term-count i))))))
-
-(defun problem-79 ()
- ;; A common security method used for online banking is to ask the user for
- ;; three random characters from a passcode. For example, if the passcode was
- ;; 531278, they may ask for the 2nd, 3rd, and 5th characters; the expected
- ;; reply would be: 317.
- ;;
- ;; The text file, keylog.txt, contains fifty successful login attempts.
- ;;
- ;; Given that the three characters are always asked for in order, analyse
- ;; the file so as to determine the shortest possible secret passcode of
- ;; unknown length.
- (let ((attempts (-<> "data/79-keylog.txt"
- read-all-from-file
- (mapcar #'digits <>)
- (mapcar (rcurry #'coerce 'vector) <>))))
- ;; Everyone in the forum is assuming that there are no duplicate digits in
- ;; the passcode, but as someone pointed out this isn't necessarily a safe
- ;; assumption. If you have attempts of (12 21) then the shortest passcode
- ;; would be 121. So we'll do things the safe way and just brute force it.
- (iterate (for passcode :from 1)
- (finding passcode :such-that
- (every (rcurry #'subsequencep (digits passcode))
- attempts)))))
-
-(defun problem-92 ()
- ;; A number chain is created by continuously adding the square of the digits
- ;; in a number to form a new number until it has been seen before.
- ;;
- ;; For example,
- ;; 44 → 32 → 13 → 10 → 1 → 1
- ;; 85 → 89 → 145 → 42 → 20 → 4 → 16 → 37 → 58 → 89
- ;;
- ;; Therefore any chain that arrives at 1 or 89 will become stuck in an
- ;; endless loop. What is most amazing is that EVERY starting number will
- ;; eventually arrive at 1 or 89.
- ;;
- ;; How many starting numbers below ten million will arrive at 89?
- (labels ((square-chain-end (i)
- (if (or (= 1 i) (= 89 i))
- i
- (square-chain-end
- (iterate (for d :in-digits-of i)
- (summing (square d)))))))
- (iterate (for i :from 1 :below 10000000)
- (counting (= 89 (square-chain-end i))))))
-
-(defun problem-145 ()
- ;; Some positive integers n have the property that the sum [ n + reverse(n) ]
- ;; consists entirely of odd (decimal) digits. For instance, 36 + 63 = 99 and
- ;; 409 + 904 = 1313. We will call such numbers reversible; so 36, 63, 409, and
- ;; 904 are reversible. Leading zeroes are not allowed in either n or
- ;; reverse(n).
- ;;
- ;; There are 120 reversible numbers below one-thousand.
- ;;
- ;; How many reversible numbers are there below one-billion (10^9)?
- (flet ((reversiblep (n)
- (let ((reversed (reverse-integer n)))
- (values (unless (zerop (digit 0 n))
- (every #'oddp (digits (+ n reversed))))
- reversed))))
- (iterate
- ;; TODO: improve this one
- ;; (with limit = 1000000000) there are no 9-digit reversible numbers...
- (with limit = 100000000)
- (with done = (make-array limit :element-type 'bit :initial-element 0))
- (for i :from 1 :below limit)
- (unless (= 1 (aref done i))
- (for (values reversible j) = (reversiblep i))
- (setf (aref done j) 1)
- (when reversible
- (sum (if (= i j) 1 2)))))))
-
-(defun problem-357 ()
- ;; Consider the divisors of 30: 1,2,3,5,6,10,15,30. It can be seen that for
- ;; every divisor d of 30, d+30/d is prime.
- ;;
- ;; Find the sum of all positive integers n not exceeding 100 000 000 such that
- ;; for every divisor d of n, d+n/d is prime.
- (labels ((check-divisor (n d)
- (primep (+ d (truncate n d))))
- (prime-generating-integer-p (n)
- (declare (optimize speed)
- (type fixnum n)
- (inline divisors-up-to-square-root))
- (every (curry #'check-divisor n)
- (divisors-up-to-square-root n))))
- ;; Observations about the candidate numbers, from various places around the
- ;; web, with my notes for humans:
- ;;
- ;; * n+1 must be prime.
- ;;
- ;; Every number has 1 has a factor, which means one of
- ;; the tests will be to see if 1+(n/1) is prime.
- ;;
- ;; * n must be even (except the edge case of 1).
- ;;
- ;; We know this because n+1 must be prime, and therefore odd, so n itself
- ;; must be even.
- ;;
- ;; * 2+(n/2) must be prime.
- ;;
- ;; Because all candidates are even, they all have 2 as a divisor (see
- ;; above), and so we can do this check before finding all the divisors.
- ;;
- ;; * n must be squarefree.
- ;;
- ;; Consider when n is squareful: then there is some prime that occurs more
- ;; than once in its factorization. Choosing this prime as the divisor for
- ;; the formula gives us d+(n/d). We know that n/d will still be divisible
- ;; by d, because we chose a d that occurs multiple times in the
- ;; factorization. Obviously d itself is divisible by d. Thus our entire
- ;; formula is divisible by d, and so not prime.
- ;;
- ;; Unfortunately this doesn't really help us much, because there's no
- ;; efficient way to tell if a number is squarefree (see
- ;; http://mathworld.wolfram.com/Squarefree.html).
- ;;
- ;; * We only have to check d <= sqrt(n).
- ;;
- ;; For each divisor d of n we know there's a twin divisor d' such that
- ;; d * d' = n (that's what it MEANS for d to be a divisor of n).
- ;;
- ;; If we plug d into the formula we have d + n/d.
- ;; We know that n/d = d', and so we have d + d'.
- ;;
- ;; If we plug d' into the formula we have d' + n/d'.
- ;; We know that n/d' = d, and so we have d' + d.
- ;;
- ;; This means that plugging d or d' into the formula both result in the
- ;; same number, so we only need to bother checking one of them.
- (1+ (iterate
- ;; edge case: skip 2 (candidiate 1), we'll add it at the end
- (for prime :in-vector (sieve (1+ 100000000)) :from 1)
- (for candidate = (1- prime))
- (when (and (check-divisor candidate 2)
- (prime-generating-integer-p candidate))
- (summing candidate))))))
-
-;;;; Tests --------------------------------------------------------------------
-(def-suite :euler)
-(in-suite :euler)
-
-(test p1 (is (= 233168 (problem-1))))
-(test p2 (is (= 4613732 (problem-2))))
-(test p3 (is (= 6857 (problem-3))))
-(test p4 (is (= 906609 (problem-4))))
-(test p5 (is (= 232792560 (problem-5))))
-(test p6 (is (= 25164150 (problem-6))))
-(test p7 (is (= 104743 (problem-7))))
-(test p8 (is (= 23514624000 (problem-8))))
-(test p9 (is (= 31875000 (problem-9))))
-(test p10 (is (= 142913828922 (problem-10))))
-(test p11 (is (= 70600674 (problem-11))))
-(test p12 (is (= 76576500 (problem-12))))
-(test p13 (is (= 5537376230 (problem-13))))
-(test p14 (is (= 837799 (problem-14))))
-(test p15 (is (= 137846528820 (problem-15))))
-(test p16 (is (= 1366 (problem-16))))
-(test p17 (is (= 21124 (problem-17))))
-(test p18 (is (= 1074 (problem-18))))
-(test p19 (is (= 171 (problem-19))))
-(test p20 (is (= 648 (problem-20))))
-(test p21 (is (= 31626 (problem-21))))
-(test p22 (is (= 871198282 (problem-22))))
-(test p23 (is (= 4179871 (problem-23))))
-(test p24 (is (= 2783915460 (problem-24))))
-(test p25 (is (= 4782 (problem-25))))
-(test p26 (is (= 983 (problem-26))))
-(test p27 (is (= -59231 (problem-27))))
-(test p28 (is (= 669171001 (problem-28))))
-(test p29 (is (= 9183 (problem-29))))
-(test p30 (is (= 443839 (problem-30))))
-(test p31 (is (= 73682 (problem-31))))
-(test p32 (is (= 45228 (problem-32))))
-(test p33 (is (= 100 (problem-33))))
-(test p34 (is (= 40730 (problem-34))))
-(test p35 (is (= 55 (problem-35))))
-(test p36 (is (= 872187 (problem-36))))
-(test p37 (is (= 748317 (problem-37))))
-(test p38 (is (= 932718654 (problem-38))))
-(test p39 (is (= 840 (problem-39))))
-(test p40 (is (= 210 (problem-40))))
-(test p41 (is (= 7652413 (problem-41))))
-(test p42 (is (= 162 (problem-42))))
-(test p43 (is (= 16695334890 (problem-43))))
-(test p44 (is (= 5482660 (problem-44))))
-(test p45 (is (= 1533776805 (problem-45))))
-(test p46 (is (= 5777 (problem-46))))
-(test p47 (is (= 134043 (problem-47))))
-(test p48 (is (= 9110846700 (problem-48))))
-(test p49 (is (= 296962999629 (problem-49))))
-(test p50 (is (= 997651 (problem-50))))
-(test p51 (is (= 121313 (problem-51))))
-(test p52 (is (= 142857 (problem-52))))
-(test p53 (is (= 4075 (problem-53))))
-(test p54 (is (= 376 (problem-54))))
-(test p55 (is (= 249 (problem-55))))
-(test p56 (is (= 972 (problem-56))))
-(test p57 (is (= 153 (problem-57))))
-(test p58 (is (= 26241 (problem-58))))
-(test p59 (is (= 107359 (problem-59))))
-(test p60 (is (= 26033 (problem-60))))
-(test p61 (is (= 28684 (problem-61))))
-(test p62 (is (= 127035954683 (problem-62))))
-(test p63 (is (= 49 (problem-63))))
-
-
-(test p74 (is (= 402 (problem-74))))
-(test p79 (is (= 73162890 (problem-79))))
-(test p92 (is (= 8581146 (problem-92))))
-(test p145 (is (= 608720 (problem-145))))
-(test p357 (is (= 1739023853137 (problem-357))))
-
-
-(defun run-tests ()
- (run! :euler))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/hungarian.lisp Thu Aug 10 20:09:14 2017 -0400
@@ -0,0 +1,375 @@
+(in-package :euler.hungarian)
+
+;;;; Data
+(defstruct (assignment-problem (:conc-name ap-)
+ (:constructor make-assignment-problem%))
+ original-matrix
+ cost-matrix
+ rows
+ cols
+ starred-rows
+ starred-cols
+ covered-rows
+ covered-cols
+ primed-rows
+ primed-cols)
+
+(define-with-macro (assignment-problem :conc-name ap)
+ original-matrix
+ cost-matrix
+ rows
+ cols
+ starred-rows
+ starred-cols
+ covered-rows
+ covered-cols
+ primed-rows
+ primed-cols)
+
+(defun make-assignment-problem (matrix)
+ (destructuring-bind (rows cols) (array-dimensions matrix)
+ (make-assignment-problem%
+ :original-matrix matrix
+ :cost-matrix (copy-array matrix)
+ :rows rows
+ :cols cols
+ :starred-rows (make-array rows :initial-element nil)
+ :starred-cols (make-array cols :initial-element nil)
+ :covered-rows (make-array rows :initial-element nil)
+ :covered-cols (make-array cols :initial-element nil)
+ :primed-rows (make-array rows :initial-element nil)
+ :primed-cols (make-array cols :initial-element nil))))
+
+
+;;;; Debug
+(defun dump (data)
+ (with-assignment-problem (data)
+ (format t " ~{ ~A ~^ ~}~%"
+ (iterate (for col :below cols)
+ (collect (if (col-covered-p data col) #\X #\space))))
+ (dotimes (row rows)
+ (format t "~A [~{~4D~A~A~^ ~}]~%"
+ (if (row-covered-p data row) #\X #\space)
+ (iterate (for col :below cols)
+ (collect (aref cost-matrix row col))
+ (collect
+ (if (starredp data row col)
+ #\*
+ #\space))
+ (collect
+ (if (primedp data row col)
+ #\'
+ #\space))))))
+ (pr))
+
+
+;;;; Marking
+(defun mark (row col row-vector col-vector)
+ (setf (aref row-vector row) col
+ (aref col-vector col) row))
+
+(defun unmark (row col row-vector col-vector)
+ (when (eql (aref row-vector row) col)
+ (setf (aref row-vector row) nil))
+ (when (eql (aref col-vector col) row)
+ (setf (aref col-vector col) nil)))
+
+
+;;;; Starring
+(defun star (data row col)
+ (with-assignment-problem (data)
+ (mark row col starred-rows starred-cols)))
+
+(defun unstar (data row col)
+ (with-assignment-problem (data)
+ (unmark row col starred-rows starred-cols)))
+
+(defun row-starred-p (data row)
+ (aref (ap-starred-rows data) row))
+
+(defun col-starred-p (data col)
+ (aref (ap-starred-cols data) col))
+
+(defun starred-col-for-row (data row)
+ (aref (ap-starred-rows data) row))
+
+(defun starred-row-for-col (data col)
+ (aref (ap-starred-cols data) col))
+
+(defun starred-list (data)
+ (with-assignment-problem (data)
+ (gathering
+ (dotimes (row rows)
+ (gather (cons row (starred-col-for-row data row)))))))
+
+(defun starredp (data row col)
+ (eql (starred-col-for-row data row) col))
+
+
+;;;; Priming
+(defun prime (data row col)
+ (with-assignment-problem (data)
+ (mark row col primed-rows primed-cols)))
+
+(defun unprime (data row col)
+ (with-assignment-problem (data)
+ (unmark row col primed-rows primed-cols)))
+
+(defun unprime-all (data)
+ (fill (ap-primed-rows data) nil)
+ (fill (ap-primed-cols data) nil))
+
+(defun primed-col-for-row (data row)
+ (aref (ap-primed-rows data) row))
+
+(defun primed-row-for-col (data col)
+ (aref (ap-primed-cols data) col))
+
+(defun primedp (data row col)
+ (eql (primed-col-for-row data row) col))
+
+
+;;;; Covering
+(defun cover-row (data row)
+ (setf (aref (ap-covered-rows data) row) t))
+
+(defun cover-col (data col)
+ (setf (aref (ap-covered-cols data) col) t))
+
+(defun uncover-row (data row)
+ (setf (aref (ap-covered-rows data) row) nil))
+
+(defun uncover-col (data col)
+ (setf (aref (ap-covered-cols data) col) nil))
+
+(defun row-covered-p (data row)
+ (aref (ap-covered-rows data) row))
+
+(defun col-covered-p (data col)
+ (aref (ap-covered-cols data) col))
+
+(defun uncover-all (data)
+ (fill (ap-covered-rows data) nil)
+ (fill (ap-covered-cols data) nil))
+
+
+(defmacro-driver (FOR var INDEXES-OF element IN vector)
+ (let ((kwd (if generate 'generate 'for)))
+ (with-gensyms (vec el)
+ `(progn
+ (with ,vec = ,vector)
+ (with ,el = ,element)
+ (,kwd ,var :next
+ (or (position ,el ,vec :start (if-first-time 0 (1+ ,var)))
+ (terminate)))))))
+
+(defmacro-driver (FOR var IN-UNCOVERED-ROWS assignment-problem)
+ (let ((kwd (if generate 'generate 'for)))
+ `(,kwd ,var :indexes-of nil :in (ap-covered-rows ,assignment-problem))))
+
+(defmacro-driver (FOR var IN-UNCOVERED-COLS assignment-problem)
+ (let ((kwd (if generate 'generate 'for)))
+ `(,kwd ,var :indexes-of nil :in (ap-covered-cols ,assignment-problem))))
+
+(defmacro-driver (FOR var IN-COVERED-ROWS assignment-problem)
+ (let ((kwd (if generate 'generate 'for)))
+ `(,kwd ,var :indexes-of t :in (ap-covered-rows ,assignment-problem))))
+
+(defmacro-driver (FOR var IN-COVERED-COLS assignment-problem)
+ (let ((kwd (if generate 'generate 'for)))
+ `(,kwd ,var :indexes-of t :in (ap-covered-cols ,assignment-problem))))
+
+
+(defun all-rows-covered-p (data)
+ (every #'identity (ap-covered-rows data)))
+
+(defun all-cols-covered-p (data)
+ (every #'identity (ap-covered-cols data)))
+
+
+;;;; Incrementing
+(defun incf-row (data row i)
+ (with-assignment-problem (data)
+ (dotimes (col cols)
+ (incf (aref cost-matrix row col) i))))
+
+(defun incf-col (data col i)
+ (with-assignment-problem (data)
+ (dotimes (row rows)
+ (incf (aref cost-matrix row col) i))))
+
+(defun decf-row (data row i)
+ (incf-row data row (- i)))
+
+(defun decf-col (data col i)
+ (incf-col data col (- i)))
+
+
+;;;; Step 1: Initialization ---------------------------------------------------
+(defun subtract-smallest-element-in-col (data col)
+ (decf-col data col (iterate
+ (for row :below (ap-rows data))
+ (minimizing (aref (ap-cost-matrix data) row col)))))
+
+
+(defun initial-subtraction (data)
+ ;; The first step is to subtract the smallest item in each column from all
+ ;; entries in the column.
+ (with-assignment-problem (data)
+ (dotimes (col cols)
+ (subtract-smallest-element-in-col data col))))
+
+(defun initial-zero-starring (data)
+ ;; Find a zero Z in the distance matrix.
+ ;;
+ ;; If there is no starred zero already in its row or column, star this zero.
+ ;;
+ ;; Repeat steps 1.1, 1.2 until all zeros have been considered.
+ (with-assignment-problem (data)
+ (iterate
+ ;; This could be faster if we split the iteration and bailed after marking
+ ;; the first thing in a row, but meh, it's cleaner this way.
+ (for (value row col) :in-array cost-matrix)
+ (when (and (zerop value)
+ (not (row-starred-p data row))
+ (not (col-starred-p data col)))
+ (star data row col)))))
+
+
+(defun step-1 (data)
+ (initial-subtraction data)
+ (initial-zero-starring data)
+ (step-2 data))
+
+
+;;;; Step 2: Z* Count and Solution Assessment ---------------------------------
+(defun cover-all-starred-columns (data)
+ (with-assignment-problem (data)
+ (dotimes (col cols)
+ (when (col-starred-p data col)
+ (cover-col data col)))))
+
+
+(defun step-2 (data)
+ ;; Cover every column containing a Z*.
+ ;;
+ ;; Terminate the algorithm if all columns are covered. In this case, the
+ ;; locations of the entries in the matrix provide the solution to the
+ ;; assignment problem.
+ (cover-all-starred-columns data)
+ (if (all-cols-covered-p data)
+ (report-solution data)
+ (step-3 data)))
+
+
+
+;;;; Step 3: Main Zero Search -------------------------------------------------
+(defun find-uncovered-zero (data)
+ (iterate (for row :in-uncovered-rows data)
+ (iterate (for col :in-uncovered-cols data)
+ (when (zerop (aref (ap-cost-matrix data) row col))
+ (return-from find-uncovered-zero (values t row col)))))
+ (values nil nil nil))
+
+(defun step-3 (data)
+ ;; Find an uncovered Z in the distance matrix and prime it, Z -> Z'. If no
+ ;; such zero exists, go to Step 5.
+ (multiple-value-bind (found row col) (find-uncovered-zero data)
+ (if (not found)
+ (step-5 data)
+ (progn
+ (prime data row col)
+ (let ((starred-col (starred-col-for-row data row)))
+ (if (not starred-col)
+ ;; If No Z* exists in the row of the Z', go to Step 4.
+ (step-4 data row col)
+ ;; If a Z* exists, cover this row and uncover the column of the Z*.
+ ;; Return to Step 3.1 to find a new Z.
+ (progn (cover-row data row)
+ (uncover-col data starred-col)
+ (step-3 data))))))))
+
+
+;;;; Step 4: Increment Set of Starred Zeros -----------------------------------
+(defun construct-zero-sequence (data initial-row initial-col)
+ (gathering
+ (labels
+ ((find-next-starred (prime-col)
+ ;; The Z* in the same column as the given Z', if one exists.
+ (let ((star-row (starred-row-for-col data prime-col)))
+ (if (null star-row)
+ (values nil nil)
+ (values star-row prime-col))))
+ (find-next-primed (star-row)
+ ;; The Z' in the same row as the given Z* (there will always be one).
+ (values star-row (primed-col-for-row data star-row)))
+ (mark-starred (row col)
+ (when row
+ (gather (cons row col))
+ (multiple-value-call #'mark-primed (find-next-primed row))))
+ (mark-primed (row col)
+ (gather (cons row col))
+ (multiple-value-call #'mark-starred (find-next-starred col))))
+ (mark-primed initial-row initial-col))))
+
+(defun process-zero-sequence (data zeros)
+ ;; Unstar each starred zero of the sequence.
+ ;;
+ ;; Star each primed zero of the sequence, thus increasing the number of
+ ;; starred zeros by one.
+ (iterate (for (row . col) :in zeros)
+ (for primed? :first t :then (not primed?))
+ (if primed?
+ (star data row col)
+ (unstar data row col))))
+
+(defun step-4 (data row col)
+ (process-zero-sequence data (construct-zero-sequence data row col))
+ (unprime-all data)
+ (uncover-all data)
+ (step-2 data))
+
+
+;;;; Step 5: New Zero Manufactures --------------------------------------------
+(defun find-smallest-uncovered-entry (data)
+ (iterate
+ main
+ (for row :in-uncovered-rows data)
+ (iterate (for col :in-uncovered-cols data)
+ (in main (minimizing (aref (ap-cost-matrix data) row col))))))
+
+(defun incf-covered-rows (data i)
+ (iterate (for row :in-covered-rows data)
+ (incf-row data row i)))
+
+(defun decf-uncovered-cols (data i)
+ (iterate (for col :in-uncovered-cols data)
+ (decf-col data col i)))
+
+
+(defun step-5 (data)
+ ;; Let h be the smallest uncovered entry in the (modified) distance matrix.
+ ;;
+ ;; Add h to all covered rows.
+ ;;
+ ;; Subtract h from all uncovered columns
+ ;;
+ ;; Return to Step 3, without altering stars, primes, or covers.
+ (let ((i (find-smallest-uncovered-entry data)))
+ (incf-covered-rows data i)
+ (decf-uncovered-cols data i)
+ (step-3 data)))
+
+
+;;;; Reporting Solution -------------------------------------------------------
+(defun report-solution (data)
+ (starred-list data))
+
+
+;;;; API ----------------------------------------------------------------------
+(defun find-minimal-assignment (matrix)
+ (step-1 (make-assignment-problem matrix)))
+
+
+;;;; Scratch ------------------------------------------------------------------
+;; (untrace)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/problems.lisp Thu Aug 10 20:09:14 2017 -0400
@@ -0,0 +1,1897 @@
+(in-package :euler)
+
+(defun problem-1 ()
+ ;; If we list all the natural numbers below 10 that are multiples of 3 or 5,
+ ;; we get 3, 5, 6 and 9. The sum of these multiples is 23.
+ ;;
+ ;; Find the sum of all the multiples of 3 or 5 below 1000.
+ (iterate (for i :from 1 :below 1000)
+ (when (or (dividesp i 3)
+ (dividesp i 5))
+ (sum i))))
+
+(defun problem-2 ()
+ ;; Each new term in the Fibonacci sequence is generated by adding the previous
+ ;; two terms. By starting with 1 and 2, the first 10 terms will be:
+ ;;
+ ;; 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
+ ;;
+ ;; By considering the terms in the Fibonacci sequence whose values do not
+ ;; exceed four million, find the sum of the even-valued terms.
+ (iterate (for n :in-fibonacci t)
+ (while (<= n 4000000))
+ (when (evenp n)
+ (sum n))))
+
+(defun problem-3 ()
+ ;; The prime factors of 13195 are 5, 7, 13 and 29.
+ ;;
+ ;; What is the largest prime factor of the number 600851475143 ?
+ (apply #'max (prime-factorization 600851475143)))
+
+(defun problem-4 ()
+ ;; A palindromic number reads the same both ways. The largest palindrome made
+ ;; from the product of two 2-digit numbers is 9009 = 91 × 99.
+ ;;
+ ;; Find the largest palindrome made from the product of two 3-digit numbers.
+ (iterate (for-nested ((i :from 0 :to 999)
+ (j :from 0 :to 999)))
+ (for product = (* i j))
+ (when (palindromep product)
+ (maximize product))))
+
+(defun problem-5 ()
+ ;; 2520 is the smallest number that can be divided by each of the numbers from
+ ;; 1 to 10 without any remainder.
+ ;;
+ ;; What is the smallest positive number that is evenly divisible by all of the
+ ;; numbers from 1 to 20?
+ (iterate
+ ;; all numbers are divisible by 1 and we can skip checking everything <= 10
+ ;; because:
+ ;;
+ ;; anything divisible by 12 is automatically divisible by 2
+ ;; anything divisible by 12 is automatically divisible by 3
+ ;; anything divisible by 12 is automatically divisible by 4
+ ;; anything divisible by 15 is automatically divisible by 5
+ ;; anything divisible by 12 is automatically divisible by 6
+ ;; anything divisible by 14 is automatically divisible by 7
+ ;; anything divisible by 16 is automatically divisible by 8
+ ;; anything divisible by 18 is automatically divisible by 9
+ ;; anything divisible by 20 is automatically divisible by 10
+ (with divisors = (range 11 20))
+ (for i :from 20 :by 20) ; it must be divisible by 20
+ (finding i :such-that (every (curry #'dividesp i) divisors))))
+
+(defun problem-6 ()
+ ;; The sum of the squares of the first ten natural numbers is,
+ ;; 1² + 2² + ... + 10² = 385
+ ;;
+ ;; The square of the sum of the first ten natural numbers is,
+ ;; (1 + 2 + ... + 10)² = 55² = 3025
+ ;;
+ ;; Hence the difference between the sum of the squares of the first ten
+ ;; natural numbers and the square of the sum is 3025 − 385 = 2640.
+ ;;
+ ;; Find the difference between the sum of the squares of the first one hundred
+ ;; natural numbers and the square of the sum.
+ (flet ((sum-of-squares (to)
+ (sum (irange 1 to :key #'square)))
+ (square-of-sum (to)
+ (square (sum (irange 1 to)))))
+ (abs (- (sum-of-squares 100) ; apparently it wants the absolute value
+ (square-of-sum 100)))))
+
+(defun problem-7 ()
+ ;; By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see
+ ;; that the 6th prime is 13.
+ ;;
+ ;; What is the 10 001st prime number?
+ (nth-prime 10001))
+
+(defun problem-8 ()
+ ;; The four adjacent digits in the 1000-digit number that have the greatest
+ ;; product are 9 × 9 × 8 × 9 = 5832.
+ ;;
+ ;; Find the thirteen adjacent digits in the 1000-digit number that have the
+ ;; greatest product. What is the value of this product?
+ (let ((digits (map 'list #'digit-char-p
+ "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450")))
+ (iterate (for window :in (n-grams 13 digits))
+ (maximize (apply #'* window)))))
+
+(defun problem-9 ()
+ ;; A Pythagorean triplet is a set of three natural numbers, a < b < c, for
+ ;; which:
+ ;;
+ ;; a² + b² = c²
+ ;;
+ ;; For example, 3² + 4² = 9 + 16 = 25 = 5².
+ ;;
+ ;; There exists exactly one Pythagorean triplet for which a + b + c = 1000.
+ ;; Find the product abc.
+ (product (first (pythagorean-triplets-of-perimeter 1000))))
+
+(defun problem-10 ()
+ ;; The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
+ ;; Find the sum of all the primes below two million.
+ (sum (sieve 2000000)))
+
+(defun problem-11 ()
+ ;; In the 20×20 grid below, four numbers along a diagonal line have been marked
+ ;; in red.
+ ;;
+ ;; The product of these numbers is 26 × 63 × 78 × 14 = 1788696.
+ ;;
+ ;; What is the greatest product of four adjacent numbers in the same direction
+ ;; (up, down, left, right, or diagonally) in the 20×20 grid?
+ (let ((grid
+ #2A((08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08)
+ (49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00)
+ (81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65)
+ (52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91)
+ (22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80)
+ (24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50)
+ (32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70)
+ (67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21)
+ (24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72)
+ (21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95)
+ (78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92)
+ (16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57)
+ (86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58)
+ (19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40)
+ (04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66)
+ (88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69)
+ (04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36)
+ (20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16)
+ (20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54)
+ (01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48))))
+ (max
+ ;; horizontal
+ (iterate (for-nested ((row :from 0 :below 20)
+ (col :from 0 :below 16)))
+ (maximize (* (aref grid row (+ 0 col))
+ (aref grid row (+ 1 col))
+ (aref grid row (+ 2 col))
+ (aref grid row (+ 3 col)))))
+ ;; vertical
+ (iterate (for-nested ((row :from 0 :below 16)
+ (col :from 0 :below 20)))
+ (maximize (* (aref grid (+ 0 row) col)
+ (aref grid (+ 1 row) col)
+ (aref grid (+ 2 row) col)
+ (aref grid (+ 3 row) col))))
+ ;; backslash \
+ (iterate (for-nested ((row :from 0 :below 16)
+ (col :from 0 :below 16)))
+ (maximize (* (aref grid (+ 0 row) (+ 0 col))
+ (aref grid (+ 1 row) (+ 1 col))
+ (aref grid (+ 2 row) (+ 2 col))
+ (aref grid (+ 3 row) (+ 3 col)))))
+ ;; slash /
+ (iterate (for-nested ((row :from 3 :below 20)
+ (col :from 0 :below 16)))
+ (maximize (* (aref grid (- row 0) (+ 0 col))
+ (aref grid (- row 1) (+ 1 col))
+ (aref grid (- row 2) (+ 2 col))
+ (aref grid (- row 3) (+ 3 col))))))))
+
+(defun problem-12 ()
+ ;; The sequence of triangle numbers is generated by adding the natural
+ ;; numbers. So the 7th triangle number would be
+ ;; 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. The first ten terms would be:
+ ;;
+ ;; 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
+ ;;
+ ;; Let us list the factors of the first seven triangle numbers:
+ ;;
+ ;; 1: 1
+ ;; 3: 1,3
+ ;; 6: 1,2,3,6
+ ;; 10: 1,2,5,10
+ ;; 15: 1,3,5,15
+ ;; 21: 1,3,7,21
+ ;; 28: 1,2,4,7,14,28
+ ;;
+ ;; We can see that 28 is the first triangle number to have over five divisors.
+ ;;
+ ;; What is the value of the first triangle number to have over five hundred
+ ;; divisors?
+ (iterate
+ (for tri :key #'triangle :from 1)
+ (finding tri :such-that (> (count-divisors tri) 500))))
+
+(defun problem-13 ()
+ ;; Work out the first ten digits of the sum of the following one-hundred
+ ;; 50-digit numbers.
+ (-<> (+ 37107287533902102798797998220837590246510135740250
+ 46376937677490009712648124896970078050417018260538
+ 74324986199524741059474233309513058123726617309629
+ 91942213363574161572522430563301811072406154908250
+ 23067588207539346171171980310421047513778063246676
+ 89261670696623633820136378418383684178734361726757
+ 28112879812849979408065481931592621691275889832738
+ 44274228917432520321923589422876796487670272189318
+ 47451445736001306439091167216856844588711603153276
+ 70386486105843025439939619828917593665686757934951
+ 62176457141856560629502157223196586755079324193331
+ 64906352462741904929101432445813822663347944758178
+ 92575867718337217661963751590579239728245598838407
+ 58203565325359399008402633568948830189458628227828
+ 80181199384826282014278194139940567587151170094390
+ 35398664372827112653829987240784473053190104293586
+ 86515506006295864861532075273371959191420517255829
+ 71693888707715466499115593487603532921714970056938
+ 54370070576826684624621495650076471787294438377604
+ 53282654108756828443191190634694037855217779295145
+ 36123272525000296071075082563815656710885258350721
+ 45876576172410976447339110607218265236877223636045
+ 17423706905851860660448207621209813287860733969412
+ 81142660418086830619328460811191061556940512689692
+ 51934325451728388641918047049293215058642563049483
+ 62467221648435076201727918039944693004732956340691
+ 15732444386908125794514089057706229429197107928209
+ 55037687525678773091862540744969844508330393682126
+ 18336384825330154686196124348767681297534375946515
+ 80386287592878490201521685554828717201219257766954
+ 78182833757993103614740356856449095527097864797581
+ 16726320100436897842553539920931837441497806860984
+ 48403098129077791799088218795327364475675590848030
+ 87086987551392711854517078544161852424320693150332
+ 59959406895756536782107074926966537676326235447210
+ 69793950679652694742597709739166693763042633987085
+ 41052684708299085211399427365734116182760315001271
+ 65378607361501080857009149939512557028198746004375
+ 35829035317434717326932123578154982629742552737307
+ 94953759765105305946966067683156574377167401875275
+ 88902802571733229619176668713819931811048770190271
+ 25267680276078003013678680992525463401061632866526
+ 36270218540497705585629946580636237993140746255962
+ 24074486908231174977792365466257246923322810917141
+ 91430288197103288597806669760892938638285025333403
+ 34413065578016127815921815005561868836468420090470
+ 23053081172816430487623791969842487255036638784583
+ 11487696932154902810424020138335124462181441773470
+ 63783299490636259666498587618221225225512486764533
+ 67720186971698544312419572409913959008952310058822
+ 95548255300263520781532296796249481641953868218774
+ 76085327132285723110424803456124867697064507995236
+ 37774242535411291684276865538926205024910326572967
+ 23701913275725675285653248258265463092207058596522
+ 29798860272258331913126375147341994889534765745501
+ 18495701454879288984856827726077713721403798879715
+ 38298203783031473527721580348144513491373226651381
+ 34829543829199918180278916522431027392251122869539
+ 40957953066405232632538044100059654939159879593635
+ 29746152185502371307642255121183693803580388584903
+ 41698116222072977186158236678424689157993532961922
+ 62467957194401269043877107275048102390895523597457
+ 23189706772547915061505504953922979530901129967519
+ 86188088225875314529584099251203829009407770775672
+ 11306739708304724483816533873502340845647058077308
+ 82959174767140363198008187129011875491310547126581
+ 97623331044818386269515456334926366572897563400500
+ 42846280183517070527831839425882145521227251250327
+ 55121603546981200581762165212827652751691296897789
+ 32238195734329339946437501907836945765883352399886
+ 75506164965184775180738168837861091527357929701337
+ 62177842752192623401942399639168044983993173312731
+ 32924185707147349566916674687634660915035914677504
+ 99518671430235219628894890102423325116913619626622
+ 73267460800591547471830798392868535206946944540724
+ 76841822524674417161514036427982273348055556214818
+ 97142617910342598647204516893989422179826088076852
+ 87783646182799346313767754307809363333018982642090
+ 10848802521674670883215120185883543223812876952786
+ 71329612474782464538636993009049310363619763878039
+ 62184073572399794223406235393808339651327408011116
+ 66627891981488087797941876876144230030984490851411
+ 60661826293682836764744779239180335110989069790714
+ 85786944089552990653640447425576083659976645795096
+ 66024396409905389607120198219976047599490197230297
+ 64913982680032973156037120041377903785566085089252
+ 16730939319872750275468906903707539413042652315011
+ 94809377245048795150954100921645863754710598436791
+ 78639167021187492431995700641917969777599028300699
+ 15368713711936614952811305876380278410754449733078
+ 40789923115535562561142322423255033685442488917353
+ 44889911501440648020369068063960672322193204149535
+ 41503128880339536053299340368006977710650566631954
+ 81234880673210146739058568557934581403627822703280
+ 82616570773948327592232845941706525094512325230608
+ 22918802058777319719839450180888072429661980811197
+ 77158542502016545090413245809786882778948721859617
+ 72107838435069186155435662884062257473692284509516
+ 20849603980134001723930671666823555245252804609722
+ 53503534226472524250874054075591789781264330331690)
+ aesthetic-string
+ (subseq <> 0 10)
+ parse-integer
+ (nth-value 0 <>)))
+
+(defun problem-14 ()
+ ;; The following iterative sequence is defined for the set of positive
+ ;; integers:
+ ;;
+ ;; n → n/2 (n is even)
+ ;; n → 3n + 1 (n is odd)
+ ;;
+ ;; Using the rule above and starting with 13, we generate the following
+ ;; sequence:
+ ;;
+ ;; 13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
+ ;;
+ ;; It can be seen that this sequence (starting at 13 and finishing at 1)
+ ;; contains 10 terms. Although it has not been proved yet (Collatz Problem),
+ ;; it is thought that all starting numbers finish at 1.
+ ;;
+ ;; Which starting number, under one million, produces the longest chain?
+ ;;
+ ;; NOTE: Once the chain starts the terms are allowed to go above one million.
+ (iterate (for i :from 1 :below 1000000)
+ (finding i :maximizing #'collatz-length)))
+
+(defun problem-15 ()
+ ;; Starting in the top left corner of a 2×2 grid, and only being able to move
+ ;; to the right and down, there are exactly 6 routes to the bottom right
+ ;; corner.
+ ;;
+ ;; How many such routes are there through a 20×20 grid?
+ (binomial-coefficient 40 20))
+
+(defun problem-16 ()
+ ;; 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?
+ (sum (digits (expt 2 1000))))
+
+(defun problem-17 ()
+ ;; 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, which is awful.
+ (labels ((letters (n)
+ (-<> n
+ (format nil "~R" <>)
+ (count-if #'alpha-char-p <>)))
+ (has-british-and (n)
+ (or (< n 100)
+ (zerop (mod n 100))))
+ (silly-british-letters (n)
+ (+ (letters n)
+ (if (has-british-and n) 0 3))))
+ (sum (irange 1 1000)
+ :key #'silly-british-letters)))
+
+(defun problem-18 ()
+ ;; 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 4
+ ;; 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.
+ ;;
+ ;; 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)
+ (let ((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))))
+ (car (reduce (lambda (prev last)
+ (mapcar #'+
+ prev
+ (mapcar #'max last (rest last))))
+ triangle
+ :from-end t))))
+
+(defun problem-19 ()
+ ;; 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)?
+ (iterate
+ (for-nested ((year :from 1901 :to 2000)
+ (month :from 1 :to 12)))
+ (counting (-<> (local-time:encode-timestamp 0 0 0 0 1 month year)
+ local-time:timestamp-day-of-week
+ zerop))))
+
+(defun problem-20 ()
+ ;; n! means n × (n − 1) × ... × 3 × 2 × 1
+ ;;
+ ;; For example, 10! = 10 × 9 × ... × 3 × 2 × 1 = 3628800,
+ ;; and the sum of the digits in the number 10! is 3 + 6 + 2 + 8 + 8 + 0 + 0 = 27.
+ ;;
+ ;; Find the sum of the digits in the number 100!
+ (sum (digits (factorial 100))))
+
+(defun problem-21 ()
+ ;; 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.
+ (labels ((sum-of-divisors (n)
+ (sum (proper-divisors n)))
+ (amicablep (n)
+ (let ((other (sum-of-divisors n)))
+ (and (not= n other)
+ (= n (sum-of-divisors other))))))
+ (sum (remove-if-not #'amicablep (range 1 10000)))))
+
+(defun problem-22 ()
+ ;; Using names.txt, a 46K text file containing over five-thousand first names,
+ ;; begin by sorting it into alphabetical order. Then working out the
+ ;; alphabetical value for each name, multiply this value by its alphabetical
+ ;; position in the list to obtain a name score.
+ ;;
+ ;; For example, when the list is sorted into alphabetical order, COLIN, which
+ ;; is worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So,
+ ;; COLIN would obtain a score of 938 × 53 = 49714.
+ ;;
+ ;; What is the total of all the name scores in the file?
+ (labels ((read-names ()
+ (-<> "data/22-names.txt"
+ parse-strings-file
+ (sort <> #'string<)))
+ (name-score (name)
+ (sum name :key #'letter-number)))
+ (iterate (for (position . name) :in
+ (enumerate (read-names) :start 1))
+ (sum (* position (name-score name))))))
+
+(defun problem-23 ()
+ ;; A perfect number is a number for which the sum of its proper divisors is
+ ;; exactly equal to the number. For example, the sum of the proper divisors of
+ ;; 28 would be 1 + 2 + 4 + 7 + 14 = 28, which means that 28 is a perfect
+ ;; number.
+ ;;
+ ;; A number n is called deficient if the sum of its proper divisors is less
+ ;; than n and it is called abundant if this sum exceeds n.
+ ;;
+ ;; As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the smallest
+ ;; number that can be written as the sum of two abundant numbers is 24. By
+ ;; mathematical analysis, it can be shown that all integers greater than 28123
+ ;; can be written as the sum of two abundant numbers. However, this upper
+ ;; limit cannot be reduced any further by analysis even though it is known
+ ;; that the greatest number that cannot be expressed as the sum of two
+ ;; abundant numbers is less than this limit.
+ ;;
+ ;; Find the sum of all the positive integers which cannot be written as the
+ ;; sum of two abundant numbers.
+ (let* ((limit 28123)
+ (abundant-numbers
+ (make-hash-set :initial-contents
+ (remove-if-not #'abundantp (irange 1 limit)))))
+ (flet ((abundant-sum-p (n)
+ (iterate (for a :in-hashset abundant-numbers)
+ (when (hset-contains-p abundant-numbers (- n a))
+ (return t)))))
+ (sum (remove-if #'abundant-sum-p (irange 1 limit))))))
+
+(defun problem-24 ()
+ ;; A permutation is an ordered arrangement of objects. For example, 3124 is
+ ;; one possible permutation of the digits 1, 2, 3 and 4. If all of the
+ ;; permutations are listed numerically or alphabetically, we call it
+ ;; lexicographic order. The lexicographic permutations of 0, 1 and 2 are:
+ ;;
+ ;; 012 021 102 120 201 210
+ ;;
+ ;; What is the millionth lexicographic permutation of the digits 0, 1, 2, 3,
+ ;; 4, 5, 6, 7, 8 and 9?
+ (-<> "0123456789"
+ (gathering-vector (:size (factorial (length <>)))
+ (map-permutations (compose #'gather #'parse-integer) <>
+ :copy nil))
+ (sort <> #'<)
+ (elt <> (1- 1000000))))
+
+(defun problem-25 ()
+ ;; The Fibonacci sequence is defined by the recurrence relation:
+ ;;
+ ;; Fn = Fn−1 + Fn−2, where F1 = 1 and F2 = 1.
+ ;;
+ ;; Hence the first 12 terms will be:
+ ;;
+ ;; F1 = 1
+ ;; F2 = 1
+ ;; F3 = 2
+ ;; F4 = 3
+ ;; F5 = 5
+ ;; F6 = 8
+ ;; F7 = 13
+ ;; F8 = 21
+ ;; F9 = 34
+ ;; F10 = 55
+ ;; F11 = 89
+ ;; F12 = 144
+ ;;
+ ;; The 12th term, F12, is the first term to contain three digits.
+ ;;
+ ;; What is the index of the first term in the Fibonacci sequence to contain
+ ;; 1000 digits?
+ (iterate (for f :in-fibonacci t)
+ (for i :from 1)
+ (finding i :such-that (= 1000 (digits-length f)))))
+
+(defun problem-26 ()
+ ;; A unit fraction contains 1 in the numerator. The decimal representation of
+ ;; the unit fractions with denominators 2 to 10 are given:
+ ;;
+ ;; 1/2 = 0.5
+ ;; 1/3 = 0.(3)
+ ;; 1/4 = 0.25
+ ;; 1/5 = 0.2
+ ;; 1/6 = 0.1(6)
+ ;; 1/7 = 0.(142857)
+ ;; 1/8 = 0.125
+ ;; 1/9 = 0.(1)
+ ;; 1/10 = 0.1
+ ;;
+ ;; Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can
+ ;; be seen that 1/7 has a 6-digit recurring cycle.
+ ;;
+ ;; Find the value of d < 1000 for which 1/d contains the longest recurring
+ ;; cycle in its decimal fraction part.
+ (iterate
+ ;; 2 and 5 are the only primes that aren't coprime to 10
+ (for i :in (set-difference (primes-below 1000) '(2 5)))
+ (finding i :maximizing (multiplicative-order 10 i))))
+
+(defun problem-27 ()
+ ;; Euler discovered the remarkable quadratic formula:
+ ;;
+ ;; n² + n + 41
+ ;;
+ ;; It turns out that the formula will produce 40 primes for the consecutive
+ ;; integer values 0 ≤ n ≤ 39. However, when n=40, 40² + 40 + 41 = 40(40 + 1)
+ ;; + 41 is divisible by 41, and certainly when n=41, 41² + 41 + 41 is clearly
+ ;; divisible by 41.
+ ;;
+ ;; The incredible formula n² − 79n + 1601 was discovered, which produces 80
+ ;; primes for the consecutive values 0 ≤ n ≤ 79. The product of the
+ ;; coefficients, −79 and 1601, is −126479.
+ ;;
+ ;; Considering quadratics of the form:
+ ;;
+ ;; n² + an + b, where |a| < 1000 and |b| ≤ 1000
+ ;;
+ ;; where |n| is the modulus/absolute value of n
+ ;; e.g. |11| = 11 and |−4| = 4
+ ;;
+ ;; Find the product of the coefficients, a and b, for the quadratic expression
+ ;; that produces the maximum number of primes for consecutive values of n,
+ ;; starting with n=0.
+ (flet ((primes-produced (a b)
+ (iterate (for n :from 0)
+ (while (primep (+ (square n) (* a n) b)))
+ (counting t))))
+ (iterate (for-nested ((a :from -999 :to 999)
+ (b :from -1000 :to 1000)))
+ (finding (* a b) :maximizing (primes-produced a b)))))
+
+(defun problem-28 ()
+ ;; Starting with the number 1 and moving to the right in a clockwise direction
+ ;; a 5 by 5 spiral is formed as follows:
+ ;;
+ ;; 21 22 23 24 25
+ ;; 20 7 8 9 10
+ ;; 19 6 1 2 11
+ ;; 18 5 4 3 12
+ ;; 17 16 15 14 13
+ ;;
+ ;; It can be verified that the sum of the numbers on the diagonals is 101.
+ ;;
+ ;; What is the sum of the numbers on the diagonals in a 1001 by 1001 spiral
+ ;; formed in the same way?
+ (iterate (for size :from 1 :to 1001 :by 2)
+ (summing (apply #'+ (number-spiral-corners size)))))
+
+(defun problem-29 ()
+ ;; Consider all integer combinations of a^b for 2 ≤ a ≤ 5 and 2 ≤ b ≤ 5:
+ ;;
+ ;; 2²=4, 2³=8, 2⁴=16, 2⁵=32
+ ;; 3²=9, 3³=27, 3⁴=81, 3⁵=243
+ ;; 4²=16, 4³=64, 4⁴=256, 4⁵=1024
+ ;; 5²=25, 5³=125, 5⁴=625, 5⁵=3125
+ ;;
+ ;; If they are then placed in numerical order, with any repeats removed, we
+ ;; get the following sequence of 15 distinct terms:
+ ;;
+ ;; 4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125
+ ;;
+ ;; How many distinct terms are in the sequence generated by a^b for
+ ;; 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?
+ (length (iterate (for-nested ((a :from 2 :to 100)
+ (b :from 2 :to 100)))
+ (adjoining (expt a b)))))
+
+(defun problem-30 ()
+ ;; Surprisingly there are only three numbers that can be written as the sum of
+ ;; fourth powers of their digits:
+ ;;
+ ;; 1634 = 1⁴ + 6⁴ + 3⁴ + 4⁴
+ ;; 8208 = 8⁴ + 2⁴ + 0⁴ + 8⁴
+ ;; 9474 = 9⁴ + 4⁴ + 7⁴ + 4⁴
+ ;;
+ ;; As 1 = 1⁴ is not a sum it is not included.
+ ;;
+ ;; The sum of these numbers is 1634 + 8208 + 9474 = 19316.
+ ;;
+ ;; Find the sum of all the numbers that can be written as the sum of fifth
+ ;; powers of their digits.
+ (flet ((maximum-sum-for-digits (n)
+ (* (expt 9 5) n))
+ (digit-power-sum (n)
+ (sum (mapcar (rcurry #'expt 5) (digits n)))))
+ (iterate
+ ;; We want to find a limit N that's bigger than the maximum possible sum
+ ;; for its number of digits.
+ (with limit = (iterate (for digits :from 1)
+ (for n = (expt 10 digits))
+ (while (< n (maximum-sum-for-digits digits)))
+ (finally (return n))))
+ ;; Then just brute-force the thing.
+ (for i :from 2 :to limit)
+ (when (= i (digit-power-sum i))
+ (summing i)))))
+
+(defun problem-31 ()
+ ;; In England the currency is made up of pound, £, and pence, p, and there are
+ ;; eight coins in general circulation:
+ ;;
+ ;; 1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) and £2 (200p).
+ ;;
+ ;; It is possible to make £2 in the following way:
+ ;;
+ ;; 1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p
+ ;;
+ ;; How many different ways can £2 be made using any number of coins?
+ (recursively ((amount 200)
+ (coins '(200 100 50 20 10 5 2 1)))
+ (cond
+ ((zerop amount) 1)
+ ((minusp amount) 0)
+ ((null coins) 0)
+ (t (+ (recur (- amount (first coins)) coins)
+ (recur amount (rest coins)))))))
+
+(defun problem-32 ()
+ ;; We shall say that an n-digit number is pandigital if it makes use of all
+ ;; the digits 1 to n exactly once; for example, the 5-digit number, 15234, is
+ ;; 1 through 5 pandigital.
+ ;;
+ ;; The product 7254 is unusual, as the identity, 39 × 186 = 7254, containing
+ ;; multiplicand, multiplier, and product is 1 through 9 pandigital.
+ ;;
+ ;; Find the sum of all products whose multiplicand/multiplier/product identity
+ ;; can be written as a 1 through 9 pandigital.
+ ;;
+ ;; HINT: Some products can be obtained in more than one way so be sure to only
+ ;; include it once in your sum.
+ (labels ((split (digits a b)
+ (values (digits-to-number (subseq digits 0 a))
+ (digits-to-number (subseq digits a (+ a b)))
+ (digits-to-number (subseq digits (+ a b)))))
+ (check (digits a b)
+ (multiple-value-bind (a b c)
+ (split digits a b)
+ (when (= (* a b) c)
+ c))))
+ (-<> (gathering
+ (map-permutations (lambda (digits)
+ (let ((c1 (check digits 3 2))
+ (c2 (check digits 4 1)))
+ (when c1 (gather c1))
+ (when c2 (gather c2))))
+ #(1 2 3 4 5 6 7 8 9)
+ :copy nil))
+ remove-duplicates
+ sum)))
+
+(defun problem-33 ()
+ ;; The fraction 49/98 is a curious fraction, as an inexperienced mathematician
+ ;; in attempting to simplify it may incorrectly believe that 49/98 = 4/8,
+ ;; which is correct, is obtained by cancelling the 9s.
+ ;;
+ ;; We shall consider fractions like, 30/50 = 3/5, to be trivial examples.
+ ;;
+ ;; There are exactly four non-trivial examples of this type of fraction, less
+ ;; than one in value, and containing two digits in the numerator and
+ ;; denominator.
+ ;;
+ ;; If the product of these four fractions is given in its lowest common terms,
+ ;; find the value of the denominator.
+ (labels ((safe/ (a b)
+ (unless (zerop b) (/ a b)))
+ (cancel (digit other digits)
+ (destructuring-bind (x y) digits
+ (remove nil (list (when (= digit x) (safe/ other y))
+ (when (= digit y) (safe/ other x))))))
+ (cancellations (numerator denominator)
+ (let ((nd (digits numerator))
+ (dd (digits denominator)))
+ (append (cancel (first nd) (second nd) dd)
+ (cancel (second nd) (first nd) dd))))
+ (curiousp (numerator denominator)
+ (member (/ numerator denominator)
+ (cancellations numerator denominator)))
+ (trivialp (numerator denominator)
+ (and (dividesp numerator 10)
+ (dividesp denominator 10))))
+ (iterate
+ (with result = 1)
+ (for numerator :from 10 :to 99)
+ (iterate (for denominator :from (1+ numerator) :to 99)
+ (when (and (curiousp numerator denominator)
+ (not (trivialp numerator denominator)))
+ (mulf result (/ numerator denominator))))
+ (finally (return (denominator result))))))
+
+(defun problem-34 ()
+ ;; 145 is a curious number, as 1! + 4! + 5! = 1 + 24 + 120 = 145.
+ ;;
+ ;; Find the sum of all numbers which are equal to the sum of the factorial of
+ ;; their digits.
+ ;;
+ ;; Note: as 1! = 1 and 2! = 2 are not sums they are not included.
+ (iterate
+ (for n :from 3 :to 1000000)
+ ;; have to use funcall here because `sum` is an iterate keyword. kill me.
+ (when (= n (funcall #'sum (digits n) :key #'factorial))
+ (summing n))))
+
+(defun problem-35 ()
+ ;; The number, 197, is called a circular prime because all rotations of the
+ ;; digits: 197, 971, and 719, are themselves prime.
+ ;;
+ ;; There are thirteen such primes below 100: 2, 3, 5, 7, 11, 13, 17, 31, 37,
+ ;; 71, 73, 79, and 97.
+ ;;
+ ;; How many circular primes are there below one million?
+ (labels ((rotate (n distance)
+ (multiple-value-bind (hi lo)
+ (truncate n (expt 10 distance))
+ (+ (* (expt 10 (digits-length hi)) lo)
+ hi)))
+ (rotations (n)
+ (mapcar (curry #'rotate n) (range 1 (digits-length n))))
+ (circular-prime-p (n)
+ (every #'primep (rotations n))))
+ (iterate (for i :in-vector (sieve 1000000))
+ (counting (circular-prime-p i)))))
+
+(defun problem-36 ()
+ ;; The decimal number, 585 = 1001001001 (binary), is palindromic in both
+ ;; bases.
+ ;;
+ ;; Find the sum of all numbers, less than one million, which are palindromic
+ ;; in base 10 and base 2.
+ ;;
+ ;; (Please note that the palindromic number, in either base, may not include
+ ;; leading zeros.)
+ (iterate (for i :from 1 :below 1000000)
+ (when (and (palindromep i 10)
+ (palindromep i 2))
+ (sum i))))
+
+(defun problem-37 ()
+ ;; The number 3797 has an interesting property. Being prime itself, it is
+ ;; possible to continuously remove digits from left to right, and remain prime
+ ;; at each stage: 3797, 797, 97, and 7. Similarly we can work from right to
+ ;; left: 3797, 379, 37, and 3.
+ ;;
+ ;; Find the sum of the only eleven primes that are both truncatable from left
+ ;; to right and right to left.
+ ;;
+ ;; NOTE: 2, 3, 5, and 7 are not considered to be truncatable primes.
+ (labels ((truncations (n)
+ (iterate (for i :from 0 :below (digits-length n))
+ (collect (truncate-number-left n i))
+ (collect (truncate-number-right n i))))
+ (truncatablep (n)
+ (every #'primep (truncations n))))
+ (iterate
+ (with count = 0)
+ (for i :from 11 :by 2)
+ (when (truncatablep i)
+ (sum i)
+ (incf count))
+ (while (< count 11)))))
+
+(defun problem-38 ()
+ ;; Take the number 192 and multiply it by each of 1, 2, and 3:
+ ;;
+ ;; 192 × 1 = 192
+ ;; 192 × 2 = 384
+ ;; 192 × 3 = 576
+ ;;
+ ;; By concatenating each product we get the 1 to 9 pandigital, 192384576. We
+ ;; will call 192384576 the concatenated product of 192 and (1,2,3)
+ ;;
+ ;; The same can be achieved by starting with 9 and multiplying by 1, 2, 3, 4,
+ ;; and 5, giving the pandigital, 918273645, which is the concatenated product
+ ;; of 9 and (1,2,3,4,5).
+ ;;
+ ;; What is the largest 1 to 9 pandigital 9-digit number that can be formed as
+ ;; the concatenated product of an integer with (1,2, ... , n) where n > 1?
+ (labels ((concatenated-product (number i)
+ (apply #'concatenate-integers
+ (iterate (for n :from 1 :to i)
+ (collect (* number n))))))
+ (iterate
+ main
+ (for base :from 1)
+ ;; base can't be more than 5 digits long because we have to concatenate at
+ ;; least two products of it
+ (while (digits<= base 5))
+ (iterate (for n :from 2)
+ (for result = (concatenated-product base n))
+ ;; result is only ever going to grow larger, so once we pass the
+ ;; nine digit mark we can stop
+ (while (digits<= result 9))
+ (when (pandigitalp result)
+ (in main (maximizing result)))))))
+
+(defun problem-39 ()
+ ;; If p is the perimeter of a right angle triangle with integral length sides,
+ ;; {a,b,c}, there are exactly three solutions for p = 120.
+ ;;
+ ;; {20,48,52}, {24,45,51}, {30,40,50}
+ ;;
+ ;; For which value of p ≤ 1000, is the number of solutions maximised?
+ (iterate
+ (for p :from 1 :to 1000)
+ (finding p :maximizing (length (pythagorean-triplets-of-perimeter p)))))
+
+(defun problem-40 ()
+ ;; An irrational decimal fraction is created by concatenating the positive
+ ;; integers:
+ ;;
+ ;; 0.123456789101112131415161718192021...
+ ;;
+ ;; It can be seen that the 12th digit of the fractional part is 1.
+ ;;
+ ;; If dn represents the nth digit of the fractional part, find the value of
+ ;; the following expression.
+ ;;
+ ;; d1 × d10 × d100 × d1000 × d10000 × d100000 × d1000000
+ (iterate
+ top
+ (with index = 0)
+ (for digits :key #'digits :from 1)
+ (iterate (for d :in digits)
+ (incf index)
+ (when (member index '(1 10 100 1000 10000 100000 1000000))
+ (in top (multiplying d))
+ (when (= index 1000000)
+ (in top (terminate)))))))
+
+(defun problem-41 ()
+ ;; We shall say that an n-digit number is pandigital if it makes use of all
+ ;; the digits 1 to n exactly once. For example, 2143 is a 4-digit pandigital
+ ;; and is also prime.
+ ;;
+ ;; What is the largest n-digit pandigital prime that exists?
+ (iterate
+ ;; There's a clever observation which reduces the upper bound from 9 to
+ ;; 7 from "gamma" in the forum:
+ ;;
+ ;; > Note: Nine numbers cannot be done (1+2+3+4+5+6+7+8+9=45 => always dividable by 3)
+ ;; > Note: Eight numbers cannot be done (1+2+3+4+5+6+7+8=36 => always dividable by 3)
+ (for n :downfrom 7)
+ (thereis (apply (nullary #'max)
+ (remove-if-not #'primep (pandigitals 1 n))))))
+
+(defun problem-42 ()
+ ;; The nth term of the sequence of triangle numbers is given by, tn = ½n(n+1);
+ ;; so the first ten triangle numbers are:
+ ;;
+ ;; 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
+ ;;
+ ;; By converting each letter in a word to a number corresponding to its
+ ;; alphabetical position and adding these values we form a word value. For
+ ;; example, the word value for SKY is 19 + 11 + 25 = 55 = t10. If the word
+ ;; value is a triangle number then we shall call the word a triangle word.
+ ;;
+ ;; Using words.txt (right click and 'Save Link/Target As...'), a 16K text file
+ ;; containing nearly two-thousand common English words, how many are triangle
+ ;; words?
+ (labels ((word-value (word)
+ (sum word :key #'letter-number))
+ (triangle-word-p (word)
+ (trianglep (word-value word))))
+ (count-if #'triangle-word-p (parse-strings-file "data/42-words.txt"))))
+
+(defun problem-43 ()
+ ;; The number, 1406357289, is a 0 to 9 pandigital number because it is made up
+ ;; of each of the digits 0 to 9 in some order, but it also has a rather
+ ;; interesting sub-string divisibility property.
+ ;;
+ ;; Let d1 be the 1st digit, d2 be the 2nd digit, and so on. In this way, we
+ ;; note the following:
+ ;;
+ ;; d2d3d4=406 is divisible by 2
+ ;; d3d4d5=063 is divisible by 3
+ ;; d4d5d6=635 is divisible by 5
+ ;; d5d6d7=357 is divisible by 7
+ ;; d6d7d8=572 is divisible by 11
+ ;; d7d8d9=728 is divisible by 13
+ ;; d8d9d10=289 is divisible by 17
+ ;;
+ ;; Find the sum of all 0 to 9 pandigital numbers with this property.
+ (labels ((extract3 (digits start)
+ (digits-to-number (subseq digits start (+ 3 start))))
+ (interestingp (n)
+ (let ((digits (digits n)))
+ ;; eat shit mathematicians, indexes start from zero
+ (and (dividesp (extract3 digits 1) 2)
+ (dividesp (extract3 digits 2) 3)
+ (dividesp (extract3 digits 3) 5)
+ (dividesp (extract3 digits 4) 7)
+ (dividesp (extract3 digits 5) 11)
+ (dividesp (extract3 digits 6) 13)
+ (dividesp (extract3 digits 7) 17)))))
+ (sum (remove-if-not #'interestingp (pandigitals 0 9)))))
+
+(defun problem-44 ()
+ ;; Pentagonal numbers are generated by the formula, Pn=n(3n−1)/2. The first
+ ;; ten pentagonal numbers are:
+ ;;
+ ;; 1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ...
+ ;;
+ ;; It can be seen that P4 + P7 = 22 + 70 = 92 = P8. However, their difference,
+ ;; 70 − 22 = 48, is not pentagonal.
+ ;;
+ ;; Find the pair of pentagonal numbers, Pj and Pk, for which their sum and
+ ;; difference are pentagonal and D = |Pk − Pj| is minimised; what is the value
+ ;; of D?
+ (flet ((interestingp (px py)
+ (and (pentagonp (+ py px))
+ (pentagonp (- py px)))))
+ (iterate
+ (with result = most-positive-fixnum) ; my kingdom for `CL:INFINITY`
+ (for y :from 2)
+ (for z :from 3)
+ (for py = (pentagon y))
+ (for pz = (pentagon z))
+ (when (>= (- pz py) result)
+ (return result))
+ (iterate
+ (for x :from (1- y) :downto 1)
+ (for px = (pentagon x))
+ (when (interestingp px py)
+ (let ((distance (- py px)))
+ (when (< distance result)
+ ;; TODO: This isn't quite right, because this is just the FIRST
+ ;; number we find -- we haven't guaranteed that it's the SMALLEST
+ ;; one we'll ever see. But it happens to accidentally be the
+ ;; correct one, and until I get around to rewriting this with
+ ;; priority queues it'll have to do.
+ (return-from problem-44 distance)))
+ (return))))))
+
+(defun problem-45 ()
+ ;; Triangle, pentagonal, and hexagonal numbers are generated by the following
+ ;; formulae:
+ ;;
+ ;; Triangle Tn=n(n+1)/2 1, 3, 6, 10, 15, ...
+ ;; Pentagonal Pn=n(3n−1)/2 1, 5, 12, 22, 35, ...
+ ;; Hexagonal Hn=n(2n−1) 1, 6, 15, 28, 45, ...
+ ;;
+ ;; It can be verified that T285 = P165 = H143 = 40755.
+ ;;
+ ;; Find the next triangle number that is also pentagonal and hexagonal.
+ (iterate
+ (for n :key #'triangle :from 286)
+ (finding n :such-that (and (pentagonp n) (hexagonp n)))))
+
+(defun problem-46 ()
+ ;; It was proposed by Christian Goldbach that every odd composite number can
+ ;; be written as the sum of a prime and twice a square.
+ ;;
+ ;; 9 = 7 + 2×1²
+ ;; 15 = 7 + 2×2²
+ ;; 21 = 3 + 2×3²
+ ;; 25 = 7 + 2×3²
+ ;; 27 = 19 + 2×2²
+ ;; 33 = 31 + 2×1²
+ ;;
+ ;; It turns out that the conjecture was false.
+ ;;
+ ;; What is the smallest odd composite that cannot be written as the sum of
+ ;; a prime and twice a square?
+ (flet ((counterexamplep (n)
+ (iterate
+ (for prime :in-vector (sieve n))
+ (never (squarep (/ (- n prime) 2))))))
+ (iterate
+ (for i :from 1 :by 2)
+ (finding i :such-that (and (compositep i)
+ (counterexamplep i))))))
+
+(defun problem-47 ()
+ ;; The first two consecutive numbers to have two distinct prime factors are:
+ ;;
+ ;; 14 = 2 × 7
+ ;; 15 = 3 × 5
+ ;;
+ ;; The first three consecutive numbers to have three distinct prime factors are:
+ ;;
+ ;; 644 = 2² × 7 × 23
+ ;; 645 = 3 × 5 × 43
+ ;; 646 = 2 × 17 × 19
+ ;;
+ ;; Find the first four consecutive integers to have four distinct prime
+ ;; factors each. What is the first of these numbers?
+ (flet ((factor-count (n)
+ (length (remove-duplicates (prime-factorization n)))))
+ (iterate
+ (with run = 0)
+ (for i :from 1)
+ (if (= 4 (factor-count i))
+ (incf run)
+ (setf run 0))
+ (finding (- i 3) :such-that (= run 4)))))
+
+(defun problem-48 ()
+ ;; The series, 1^1 + 2^2 + 3^3 + ... + 10^10 = 10405071317.
+ ;;
+ ;; Find the last ten digits of the series, 1^1 + 2^2 + 3^3 + ... + 1000^1000.
+ (-<> (irange 1 1000)
+ (mapcar #'expt <> <>)
+ sum
+ (mod <> (expt 10 10))))
+
+(defun problem-49 ()
+ ;; The arithmetic sequence, 1487, 4817, 8147, in which each of the terms
+ ;; increases by 3330, is unusual in two ways: (i) each of the three terms are
+ ;; prime, and, (ii) each of the 4-digit numbers are permutations of one
+ ;; another.
+ ;;
+ ;; There are no arithmetic sequences made up of three 1-, 2-, or 3-digit
+ ;; primes, exhibiting this property, but there is one other 4-digit increasing
+ ;; sequence.
+ ;;
+ ;; What 12-digit number do you form by concatenating the three terms in this
+ ;; sequence?
+ (labels ((permutation= (a b)
+ (orderless-equal (digits a) (digits b)))
+ (length>=3 (list)
+ (>= (length list) 3))
+ (arithmetic-sequence-p (seq)
+ (apply #'= (mapcar (curry #'apply #'-)
+ (n-grams 2 seq))))
+ (has-arithmetic-sequence-p (seq)
+ (map-combinations
+ (lambda (s)
+ (when (arithmetic-sequence-p s)
+ (return-from has-arithmetic-sequence-p s)))
+ (sort seq #'<)
+ :length 3)
+ nil))
+ (-<> (primes-in 1000 9999)
+ (equivalence-classes #'permutation= <>) ; find all permutation groups
+ (remove-if-not #'length>=3 <>) ; make sure they have at leat 3 elements
+ (mapcar #'has-arithmetic-sequence-p <>)
+ (remove nil <>)
+ (remove-if (lambda (s) (= (first s) 1487)) <>) ; remove the example
+ first
+ (mapcan #'digits <>)
+ digits-to-number)))
+
+(defun problem-50 ()
+ ;; The prime 41, can be written as the sum of six consecutive primes:
+ ;;
+ ;; 41 = 2 + 3 + 5 + 7 + 11 + 13
+ ;;
+ ;; This is the longest sum of consecutive primes that adds to a prime below
+ ;; one-hundred.
+ ;;
+ ;; The longest sum of consecutive primes below one-thousand that adds to
+ ;; a prime, contains 21 terms, and is equal to 953.
+ ;;
+ ;; Which prime, below one-million, can be written as the sum of the most
+ ;; consecutive primes?
+ (let ((primes (sieve 1000000)))
+ (flet ((score (start)
+ (iterate
+ (with score = 0)
+ (with winner = 0)
+ (for run :from 1)
+ (for prime :in-vector primes :from start)
+ (summing prime :into sum)
+ (while (< sum 1000000))
+ (when (primep sum)
+ (setf score run
+ winner sum))
+ (finally (return (values score winner))))))
+ (iterate
+ (for (values score winner)
+ :key #'score :from 0 :below (length primes))
+ (finding winner :maximizing score)))))
+
+(defun problem-51 ()
+ ;; By replacing the 1st digit of the 2-digit number *3, it turns out that six
+ ;; of the nine possible values: 13, 23, 43, 53, 73, and 83, are all prime.
+ ;;
+ ;; By replacing the 3rd and 4th digits of 56**3 with the same digit, this
+ ;; 5-digit number is the first example having seven primes among the ten
+ ;; generated numbers, yielding the family: 56003, 56113, 56333, 56443, 56663,
+ ;; 56773, and 56993. Consequently 56003, being the first member of this
+ ;; family, is the smallest prime with this property.
+ ;;
+ ;; Find the smallest prime which, by replacing part of the number (not
+ ;; necessarily adjacent digits) with the same digit, is part of an eight prime
+ ;; value family.
+ (labels
+ ((patterns (prime)
+ (iterate (with size = (digits-length prime))
+ (with indices = (range 0 size))
+ (for i :from 1 :below size)
+ (appending (combinations indices :length i))))
+ (apply-pattern-digit (prime pattern new-digit)
+ (iterate (with result = (digits prime))
+ (for index :in pattern)
+ (when (and (zerop index) (zerop new-digit))
+ (leave))
+ (setf (nth index result) new-digit)
+ (finally (return (digits-to-number result)))))
+ (apply-pattern (prime pattern)
+ (iterate (for digit in (irange 0 9))
+ (for result = (apply-pattern-digit prime pattern digit))
+ (when (and result (primep result))
+ (collect result))))
+ (apply-patterns (prime)
+ (mapcar (curry #'apply-pattern prime) (patterns prime)))
+ (winnerp (prime)
+ (find-if (curry #'length= 8) (apply-patterns prime))))
+ (-<> (iterate (for i :from 3 :by 2)
+ (thereis (and (primep i) (winnerp i))))
+ (sort< <>)
+ first)))
+
+(defun problem-52 ()
+ ;; It can be seen that the number, 125874, and its double, 251748, contain
+ ;; exactly the same digits, but in a different order.
+ ;;
+ ;; Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x,
+ ;; contain the same digits.
+ (iterate (for i :from 1)
+ (for digits = (digits i))
+ (finding i :such-that
+ (every (lambda (n)
+ (orderless-equal digits (digits (* n i))))
+ '(2 3 4 5 6)))))
+
+(defun problem-53 ()
+ ;; There are exactly ten ways of selecting three from five, 12345:
+ ;;
+ ;; 123, 124, 125, 134, 135, 145, 234, 235, 245, and 345
+ ;;
+ ;; In combinatorics, we use the notation, 5C3 = 10.
+ ;;
+ ;; In general,
+ ;;
+ ;; nCr = n! / r!(n−r)!
+ ;;
+ ;; where r ≤ n, n! = n×(n−1)×...×3×2×1, and 0! = 1.
+ ;;
+ ;; It is not until n = 23, that a value exceeds one-million: 23C10 = 1144066.
+ ;;
+ ;; How many, not necessarily distinct, values of nCr, for 1 ≤ n ≤ 100, are
+ ;; greater than one-million?
+ (iterate
+ main
+ (for n :from 1 :to 100)
+ (iterate
+ (for r :from 1 :to n)
+ (for nCr = (binomial-coefficient n r))
+ (in main (counting (> nCr 1000000))))))
+
+(defun problem-54 ()
+ ;; In the card game poker, a hand consists of five cards and are ranked, from
+ ;; lowest to highest, in the following way:
+ ;;
+ ;; High Card: Highest value card.
+ ;; One Pair: Two cards of the same value.
+ ;; Two Pairs: Two different pairs.
+ ;; Three of a Kind: Three cards of the same value.
+ ;; Straight: All cards are consecutive values.
+ ;; Flush: All cards of the same suit.
+ ;; Full House: Three of a kind and a pair.
+ ;; Four of a Kind: Four cards of the same value.
+ ;; Straight Flush: All cards are consecutive values of same suit.
+ ;; Royal Flush: Ten, Jack, Queen, King, Ace, in same suit.
+ ;;
+ ;; The cards are valued in the order:
+ ;; 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace.
+ ;;
+ ;; If two players have the same ranked hands then the rank made up of the
+ ;; highest value wins; for example, a pair of eights beats a pair of fives
+ ;; (see example 1 below). But if two ranks tie, for example, both players have
+ ;; a pair of queens, then highest cards in each hand are compared (see example
+ ;; 4 below); if the highest cards tie then the next highest cards are
+ ;; compared, and so on.
+ ;;
+ ;; The file, poker.txt, contains one-thousand random hands dealt to two
+ ;; players. Each line of the file contains ten cards (separated by a single
+ ;; space): the first five are Player 1's cards and the last five are Player
+ ;; 2's cards. You can assume that all hands are valid (no invalid characters
+ ;; or repeated cards), each player's hand is in no specific order, and in each
+ ;; hand there is a clear winner.
+ ;;
+ ;; How many hands does Player 1 win?
+ (iterate (for line :in-file "data/54-poker.txt" :using #'read-line)
+ (for cards = (mapcar #'euler.poker::parse-card
+ (cl-strings:split line #\space)))
+ (for p1 = (take 5 cards))
+ (for p2 = (drop 5 cards))
+ (counting (euler.poker::poker-hand-beats-p p1 p2))))
+
+(defun problem-55 ()
+ ;; If we take 47, reverse and add, 47 + 74 = 121, which is palindromic.
+ ;;
+ ;; Not all numbers produce palindromes so quickly. For example,
+ ;;
+ ;; 349 + 943 = 1292,
+ ;; 1292 + 2921 = 4213
+ ;; 4213 + 3124 = 7337
+ ;;
+ ;; That is, 349 took three iterations to arrive at a palindrome.
+ ;;
+ ;; Although no one has proved it yet, it is thought that some numbers, like
+ ;; 196, never produce a palindrome. A number that never forms a palindrome
+ ;; through the reverse and add process is called a Lychrel number. Due to the
+ ;; theoretical nature of these numbers, and for the purpose of this problem,
+ ;; we shall assume that a number is Lychrel until proven otherwise. In
+ ;; addition you are given that for every number below ten-thousand, it will
+ ;; either (i) become a palindrome in less than fifty iterations, or, (ii) no
+ ;; one, with all the computing power that exists, has managed so far to map it
+ ;; to a palindrome. In fact, 10677 is the first number to be shown to require
+ ;; over fifty iterations before producing a palindrome:
+ ;; 4668731596684224866951378664 (53 iterations, 28-digits).
+ ;;
+ ;; Surprisingly, there are palindromic numbers that are themselves Lychrel
+ ;; numbers; the first example is 4994.
+ ;;
+ ;; How many Lychrel numbers are there below ten-thousand?
+ (labels ((lychrel (n)
+ (+ n (reverse-integer n)))
+ (lychrelp (n)
+ (iterate
+ (repeat 50)
+ (for i :iterating #'lychrel :seed n)
+ (never (palindromep i)))))
+ (iterate (for i :from 0 :below 10000)
+ (counting (lychrelp i)))))
+
+(defun problem-56 ()
+ ;; A googol (10^100) is a massive number: one followed by one-hundred zeros;
+ ;; 100^100 is almost unimaginably large: one followed by two-hundred zeros.
+ ;; Despite their size, the sum of the digits in each number is only 1.
+ ;;
+ ;; Considering natural numbers of the form, a^b, where a, b < 100, what is the
+ ;; maximum digital sum?
+ (iterate (for-nested ((a :from 1 :below 100)
+ (b :from 1 :below 100)))
+ (maximizing (funcall #'sum (digits (expt a b))))))
+
+(defun problem-57 ()
+ ;; It is possible to show that the square root of two can be expressed as an
+ ;; infinite continued fraction.
+ ;;
+ ;; √ 2 = 1 + 1/(2 + 1/(2 + 1/(2 + ... ))) = 1.414213...
+ ;;
+ ;; By expanding this for the first four iterations, we get:
+ ;;
+ ;; 1 + 1/2 = 3/2 = 1.5
+ ;; 1 + 1/(2 + 1/2) = 7/5 = 1.4
+ ;; 1 + 1/(2 + 1/(2 + 1/2)) = 17/12 = 1.41666...
+ ;; 1 + 1/(2 + 1/(2 + 1/(2 + 1/2))) = 41/29 = 1.41379...
+ ;;
+ ;; The next three expansions are 99/70, 239/169, and 577/408, but the eighth
+ ;; expansion, 1393/985, is the first example where the number of digits in the
+ ;; numerator exceeds the number of digits in the denominator.
+ ;;
+ ;; In the first one-thousand expansions, how many fractions contain
+ ;; a numerator with more digits than denominator?
+ (iterate
+ (repeat 1000)
+ (for i :initially 1/2 :then (/ (+ 2 i)))
+ (for expansion = (1+ i))
+ (counting (> (digits-length (numerator expansion))
+ (digits-length (denominator expansion))))))
+
+(defun problem-58 ()
+ ;; Starting with 1 and spiralling anticlockwise in the following way, a square
+ ;; spiral with side length 7 is formed.
+ ;;
+ ;; 37 36 35 34 33 32 31
+ ;; 38 17 16 15 14 13 30
+ ;; 39 18 5 4 3 12 29
+ ;; 40 19 6 1 2 11 28
+ ;; 41 20 7 8 9 10 27
+ ;; 42 21 22 23 24 25 26
+ ;; 43 44 45 46 47 48 49
+ ;;
+ ;; It is interesting to note that the odd squares lie along the bottom right
+ ;; diagonal, but what is more interesting is that 8 out of the 13 numbers
+ ;; lying along both diagonals are prime; that is, a ratio of 8/13 ≈ 62%.
+ ;;
+ ;; If one complete new layer is wrapped around the spiral above, a square
+ ;; spiral with side length 9 will be formed. If this process is continued,
+ ;; what is the side length of the square spiral for which the ratio of primes
+ ;; along both diagonals first falls below 10%?
+ (labels ((score (value)
+ (if (primep value) 1 0))
+ (primes-in-layer (size)
+ (sum (number-spiral-corners size) :key #'score)))
+ (iterate
+ (for size :from 3 :by 2)
+ (for count :from 5 :by 4)
+ (sum (primes-in-layer size) :into primes)
+ (for ratio = (/ primes count))
+ (finding size :such-that (< ratio 1/10)))))
+
+(defun problem-59 ()
+ ;; Each character on a computer is assigned a unique code and the preferred
+ ;; standard is ASCII (American Standard Code for Information Interchange).
+ ;; For example, uppercase A = 65, asterisk (*) = 42, and lowercase k = 107.
+ ;;
+ ;; A modern encryption method is to take a text file, convert the bytes to
+ ;; ASCII, then XOR each byte with a given value, taken from a secret key. The
+ ;; advantage with the XOR function is that using the same encryption key on
+ ;; the cipher text, restores the plain text; for example, 65 XOR 42 = 107,
+ ;; then 107 XOR 42 = 65.
+ ;;
+ ;; For unbreakable encryption, the key is the same length as the plain text
+ ;; message, and the key is made up of random bytes. The user would keep the
+ ;; encrypted message and the encryption key in different locations, and
+ ;; without both "halves", it is impossible to decrypt the message.
+ ;;
+ ;; Unfortunately, this method is impractical for most users, so the modified
+ ;; method is to use a password as a key. If the password is shorter than the
+ ;; message, which is likely, the key is repeated cyclically throughout the
+ ;; message. The balance for this method is using a sufficiently long password
+ ;; key for security, but short enough to be memorable.
+ ;;
+ ;; Your task has been made easy, as the encryption key consists of three lower
+ ;; case characters. Using cipher.txt (right click and 'Save Link/Target
+ ;; As...'), a file containing the encrypted ASCII codes, and the knowledge
+ ;; that the plain text must contain common English words, decrypt the message
+ ;; and find the sum of the ASCII values in the original text.
+ (let* ((data (-<> "data/59-cipher.txt"
+ read-file-into-string
+ (substitute #\space #\, <>)
+ read-all-from-string))
+ (raw-words (-<> "/usr/share/dict/words"
+ read-file-into-string
+ (cl-strings:split <> #\newline)
+ (mapcar #'string-downcase <>)))
+ (words (make-hash-set :test 'equal :initial-contents raw-words)))
+ (labels
+ ((stringify (codes)
+ (map 'string #'code-char codes))
+ (apply-cipher (key)
+ (iterate (for number :in data)
+ (for k :in-looping key)
+ (collect (logxor number k))))
+ (score-keyword (keyword)
+ (-<> (apply-cipher keyword)
+ (stringify <>)
+ (string-downcase <>)
+ (cl-strings:split <>)
+ (remove-if-not (curry #'hset-contains-p words) <>)
+ length))
+ (answer (keyword)
+ ;; (pr (stringify keyword)) ; keyword is "god", lol
+ (sum (apply-cipher keyword))))
+ (iterate (for-nested ((a :from (char-code #\a) :to (char-code #\z))
+ (b :from (char-code #\a) :to (char-code #\z))
+ (c :from (char-code #\a) :to (char-code #\z))))
+ (for keyword = (list a b c))
+ (finding (answer keyword) :maximizing (score-keyword keyword))))))
+
+(defun problem-60 ()
+ ;; The primes 3, 7, 109, and 673, are quite remarkable. By taking any two
+ ;; primes and concatenating them in any order the result will always be prime.
+ ;; For example, taking 7 and 109, both 7109 and 1097 are prime. The sum of
+ ;; these four primes, 792, represents the lowest sum for a set of four primes
+ ;; with this property.
+ ;;
+ ;; Find the lowest sum for a set of five primes for which any two primes
+ ;; concatenate to produce another prime.
+ (labels-memoized ((concatenates-prime-p (a b)
+ (and (primep (concatenate-integers a b))
+ (primep (concatenate-integers b a)))))
+ (flet ((satisfiesp (prime primes)
+ (every (curry #'concatenates-prime-p prime) primes)))
+ (iterate
+ main
+ ;; 2 can never be part of the winning set, because if you concatenate it
+ ;; in the last position you get an even number.
+ (with primes = (subseq (sieve 10000) 1))
+ (for a :in-vector primes :with-index ai)
+ (iterate
+ (for b :in-vector primes :with-index bi :from (1+ ai))
+ (when (satisfiesp b (list a))
+ (iterate
+ (for c :in-vector primes :with-index ci :from (1+ bi))
+ (when (satisfiesp c (list a b))
+ (iterate
+ (for d :in-vector primes :with-index di :from (1+ ci))
+ (when (satisfiesp d (list a b c))
+ (iterate
+ (for e :in-vector primes :from (1+ di))
+ (when (satisfiesp e (list a b c d))
+ (in main (return-from problem-60 (+ a b c d e)))))))))))))))
+
+(defun problem-61 ()
+ ;; Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers
+ ;; are all figurate (polygonal) numbers and are generated by the following
+ ;; formulae:
+ ;;
+ ;; Triangle P3,n=n(n+1)/2 1, 3, 6, 10, 15, ...
+ ;; Square P4,n=n² 1, 4, 9, 16, 25, ...
+ ;; Pentagonal P5,n=n(3n−1)/2 1, 5, 12, 22, 35, ...
+ ;; Hexagonal P6,n=n(2n−1) 1, 6, 15, 28, 45, ...
+ ;; Heptagonal P7,n=n(5n−3)/2 1, 7, 18, 34, 55, ...
+ ;; Octagonal P8,n=n(3n−2) 1, 8, 21, 40, 65, ...
+ ;;
+ ;; The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three
+ ;; interesting properties.
+ ;;
+ ;; 1. The set is cyclic, in that the last two digits of each number is the
+ ;; first two digits of the next number (including the last number with the
+ ;; first).
+ ;; 2. Each polygonal type: triangle (P3,127=8128), square (P4,91=8281), and
+ ;; pentagonal (P5,44=2882), is represented by a different number in the
+ ;; set.
+ ;; 3. This is the only set of 4-digit numbers with this property.
+ ;;
+ ;; Find the sum of the only ordered set of six cyclic 4-digit numbers for
+ ;; which each polygonal type: triangle, square, pentagonal, hexagonal,
+ ;; heptagonal, and octagonal, is represented by a different number in the set.
+ (labels ((numbers (generator)
+ (iterate (for i :from 1)
+ (for n = (funcall generator i))
+ (while (<= n 9999))
+ (when (>= n 1000)
+ (collect n))))
+ (split (number)
+ (truncate number 100))
+ (prefix (number)
+ (when number
+ (nth-value 0 (split number))))
+ (suffix (number)
+ (when number
+ (nth-value 1 (split number))))
+ (matches (prefix suffix number)
+ (multiple-value-bind (p s)
+ (split number)
+ (and (or (not prefix)
+ (= prefix p))
+ (or (not suffix)
+ (= suffix s)))))
+ (choose (numbers used prefix &optional suffix)
+ (-<> numbers
+ (remove-if-not (curry #'matches prefix suffix) <>)
+ (set-difference <> used)))
+ (search-sets (sets)
+ (recursively ((sets sets)
+ (path nil))
+ (destructuring-bind (set . remaining) sets
+ (if remaining
+ ;; We're somewhere in the middle, recur on any number whose
+ ;; prefix matches the suffix of the previous element.
+ (iterate
+ (for number :in (choose set path (suffix (car path))))
+ (recur remaining (cons number path)))
+ ;; We're on the last set, we need to find a number that fits
+ ;; between the penultimate element and first element to
+ ;; complete the cycle.
+ (when-let*
+ ((init (first (last path)))
+ (prev (car path))
+ (final (choose set path (suffix prev) (prefix init))))
+ (return-from problem-61
+ (sum (reverse (cons (first final) path))))))))))
+ (map-permutations #'search-sets
+ (list (numbers #'triangle)
+ (numbers #'square)
+ (numbers #'pentagon)
+ (numbers #'hexagon)
+ (numbers #'heptagon)
+ (numbers #'octagon)))))
+
+(defun problem-62 ()
+ ;; The cube, 41063625 (345³), can be permuted to produce two other cubes:
+ ;; 56623104 (384³) and 66430125 (405³). In fact, 41063625 is the smallest cube
+ ;; which has exactly three permutations of its digits which are also cube.
+ ;;
+ ;; Find the smallest cube for which exactly five permutations of its digits
+ ;; are cube.
+ (let ((scores (make-hash-table))) ; canonical-repr => (count . first-cube)
+ ;; Basic strategy from [1] but with some bug fixes. His strategy happens to
+ ;; work for this specific case, but could be incorrect for others.
+ ;;
+ ;; We can't just return as soon as we hit the 5th cubic permutation, because
+ ;; what if this cube is actually part of a family of 6? Instead we need to
+ ;; check all other cubes with the same number of digits before making a
+ ;; final decision to be sure we don't get fooled.
+ ;;
+ ;; [1]: http://www.mathblog.dk/project-euler-62-cube-five-permutations/
+ (labels ((canonicalize (cube)
+ (digits-to-number (sort (digits cube) #'>)))
+ (mark (cube)
+ (let ((entry (ensure-gethash (canonicalize cube) scores
+ (cons 0 cube))))
+ (incf (car entry))
+ entry)))
+ (iterate
+ (with i = 1)
+ (with target = 5)
+ (with candidates = nil)
+ (for limit :initially 10 :then (* 10 limit))
+ (iterate
+ (for cube = (cube i))
+ (while (< cube limit))
+ (incf i)
+ (for (score . first) = (mark cube))
+ (cond ((= score target) (push first candidates))
+ ((> score target) (removef candidates first)))) ; tricksy hobbitses
+ (thereis (apply (nullary #'min) candidates))))))
+
+(defun problem-63 ()
+ ;; The 5-digit number, 16807=7^5, is also a fifth power. Similarly, the
+ ;; 9-digit number, 134217728=8^9, is a ninth power.
+ ;;
+ ;; How many n-digit positive integers exist which are also an nth power?
+ (flet ((score (n)
+ ;; 10^n will have n+1 digits, so we never need to check beyond that
+ (iterate (for base :from 1 :below 10)
+ (for value = (expt base n))
+ (counting (= n (digits-length value)))))
+ (find-bound ()
+ ;; it's 21.something, but I don't really grok why yet
+ (iterate
+ (for power :from 1)
+ (for maximum-possible-digits = (digits-length (expt 9 power)))
+ (while (>= maximum-possible-digits power))
+ (finally (return power)))))
+ (iterate (for n :from 1 :below (find-bound))
+ (sum (score n)))))
+
+(defun problem-74 ()
+ ;; The number 145 is well known for the property that the sum of the factorial
+ ;; of its digits is equal to 145:
+ ;;
+ ;; 1! + 4! + 5! = 1 + 24 + 120 = 145
+ ;;
+ ;; Perhaps less well known is 169, in that it produces the longest chain of
+ ;; numbers that link back to 169; it turns out that there are only three such
+ ;; loops that exist:
+ ;;
+ ;; 169 → 363601 → 1454 → 169
+ ;; 871 → 45361 → 871
+ ;; 872 → 45362 → 872
+ ;;
+ ;; It is not difficult to prove that EVERY starting number will eventually get
+ ;; stuck in a loop. For example,
+ ;;
+ ;; 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
+ ;; 78 → 45360 → 871 → 45361 (→ 871)
+ ;; 540 → 145 (→ 145)
+ ;;
+ ;; Starting with 69 produces a chain of five non-repeating terms, but the
+ ;; longest non-repeating chain with a starting number below one million is
+ ;; sixty terms.
+ ;;
+ ;; How many chains, with a starting number below one million, contain exactly
+ ;; sixty non-repeating terms?
+ (labels ((digit-factorial (n)
+ (sum (mapcar #'factorial (digits n))))
+ (term-count (n)
+ (iterate (for i :initially n :then (digit-factorial i))
+ (until (member i prev))
+ (collect i :into prev)
+ (counting t))))
+ (iterate (for i :from 1 :below 1000000)
+ (counting (= 60 (term-count i))))))
+
+(defun problem-79 ()
+ ;; A common security method used for online banking is to ask the user for
+ ;; three random characters from a passcode. For example, if the passcode was
+ ;; 531278, they may ask for the 2nd, 3rd, and 5th characters; the expected
+ ;; reply would be: 317.
+ ;;
+ ;; The text file, keylog.txt, contains fifty successful login attempts.
+ ;;
+ ;; Given that the three characters are always asked for in order, analyse
+ ;; the file so as to determine the shortest possible secret passcode of
+ ;; unknown length.
+ (let ((attempts (-<> "data/79-keylog.txt"
+ read-all-from-file
+ (mapcar #'digits <>)
+ (mapcar (rcurry #'coerce 'vector) <>))))
+ ;; Everyone in the forum is assuming that there are no duplicate digits in
+ ;; the passcode, but as someone pointed out this isn't necessarily a safe
+ ;; assumption. If you have attempts of (12 21) then the shortest passcode
+ ;; would be 121. So we'll do things the safe way and just brute force it.
+ (iterate (for passcode :from 1)
+ (finding passcode :such-that
+ (every (rcurry #'subsequencep (digits passcode))
+ attempts)))))
+
+(defun problem-92 ()
+ ;; A number chain is created by continuously adding the square of the digits
+ ;; in a number to form a new number until it has been seen before.
+ ;;
+ ;; For example,
+ ;; 44 → 32 → 13 → 10 → 1 → 1
+ ;; 85 → 89 → 145 → 42 → 20 → 4 → 16 → 37 → 58 → 89
+ ;;
+ ;; Therefore any chain that arrives at 1 or 89 will become stuck in an
+ ;; endless loop. What is most amazing is that EVERY starting number will
+ ;; eventually arrive at 1 or 89.
+ ;;
+ ;; How many starting numbers below ten million will arrive at 89?
+ (labels ((square-chain-end (i)
+ (if (or (= 1 i) (= 89 i))
+ i
+ (square-chain-end
+ (iterate (for d :in-digits-of i)
+ (summing (square d)))))))
+ (iterate (for i :from 1 :below 10000000)
+ (counting (= 89 (square-chain-end i))))))
+
+(defun problem-145 ()
+ ;; Some positive integers n have the property that the sum [ n + reverse(n) ]
+ ;; consists entirely of odd (decimal) digits. For instance, 36 + 63 = 99 and
+ ;; 409 + 904 = 1313. We will call such numbers reversible; so 36, 63, 409, and
+ ;; 904 are reversible. Leading zeroes are not allowed in either n or
+ ;; reverse(n).
+ ;;
+ ;; There are 120 reversible numbers below one-thousand.
+ ;;
+ ;; How many reversible numbers are there below one-billion (10^9)?
+ (flet ((reversiblep (n)
+ (let ((reversed (reverse-integer n)))
+ (values (unless (zerop (digit 0 n))
+ (every #'oddp (digits (+ n reversed))))
+ reversed))))
+ (iterate
+ ;; TODO: improve this one
+ ;; (with limit = 1000000000) there are no 9-digit reversible numbers...
+ (with limit = 100000000)
+ (with done = (make-array limit :element-type 'bit :initial-element 0))
+ (for i :from 1 :below limit)
+ (unless (= 1 (aref done i))
+ (for (values reversible j) = (reversiblep i))
+ (setf (aref done j) 1)
+ (when reversible
+ (sum (if (= i j) 1 2)))))))
+
+(defun problem-345 ()
+ ;; We define the Matrix Sum of a matrix as the maximum sum of matrix elements
+ ;; with each element being the only one in his row and column. For example,
+ ;; the Matrix Sum of the matrix below equals 3315 ( = 863 + 383 + 343 + 959
+ ;; + 767):
+ ;;
+ ;; 7 53 183 439 863
+ ;; 497 383 563 79 973
+ ;; 287 63 343 169 583
+ ;; 627 343 773 959 943
+ ;; 767 473 103 699 303
+ ;;
+ ;; Find the Matrix Sum of: ...
+ (let ((matrix
+ (copy-array
+ #2a(( 7 53 183 439 863 497 383 563 79 973 287 63 343 169 583)
+ (627 343 773 959 943 767 473 103 699 303 957 703 583 639 913)
+ (447 283 463 29 23 487 463 993 119 883 327 493 423 159 743)
+ (217 623 3 399 853 407 103 983 89 463 290 516 212 462 350)
+ (960 376 682 962 300 780 486 502 912 800 250 346 172 812 350)
+ (870 456 192 162 593 473 915 45 989 873 823 965 425 329 803)
+ (973 965 905 919 133 673 665 235 509 613 673 815 165 992 326)
+ (322 148 972 962 286 255 941 541 265 323 925 281 601 95 973)
+ (445 721 11 525 473 65 511 164 138 672 18 428 154 448 848)
+ (414 456 310 312 798 104 566 520 302 248 694 976 430 392 198)
+ (184 829 373 181 631 101 969 613 840 740 778 458 284 760 390)
+ (821 461 843 513 17 901 711 993 293 157 274 94 192 156 574)
+ ( 34 124 4 878 450 476 712 914 838 669 875 299 823 329 699)
+ (815 559 813 459 522 788 168 586 966 232 308 833 251 631 107)
+ (813 883 451 509 615 77 281 613 459 205 380 274 302 35 805)))))
+ (do-array (val matrix)
+ (negatef val))
+ (iterate
+ (for (row . col) :in (euler.hungarian:find-minimal-assignment matrix))
+ (summing (- (aref matrix row col))))))
+
+(defun problem-357 ()
+ ;; Consider the divisors of 30: 1,2,3,5,6,10,15,30. It can be seen that for
+ ;; every divisor d of 30, d+30/d is prime.
+ ;;
+ ;; Find the sum of all positive integers n not exceeding 100 000 000 such that
+ ;; for every divisor d of n, d+n/d is prime.
+ (labels ((check-divisor (n d)
+ (primep (+ d (truncate n d))))
+ (prime-generating-integer-p (n)
+ (declare (optimize speed)
+ (type fixnum n)
+ (inline divisors-up-to-square-root))
+ (every (curry #'check-divisor n)
+ (divisors-up-to-square-root n))))
+ ;; Observations about the candidate numbers, from various places around the
+ ;; web, with my notes for humans:
+ ;;
+ ;; * n+1 must be prime.
+ ;;
+ ;; Every number has 1 has a factor, which means one of
+ ;; the tests will be to see if 1+(n/1) is prime.
+ ;;
+ ;; * n must be even (except the edge case of 1).
+ ;;
+ ;; We know this because n+1 must be prime, and therefore odd, so n itself
+ ;; must be even.
+ ;;
+ ;; * 2+(n/2) must be prime.
+ ;;
+ ;; Because all candidates are even, they all have 2 as a divisor (see
+ ;; above), and so we can do this check before finding all the divisors.
+ ;;
+ ;; * n must be squarefree.
+ ;;
+ ;; Consider when n is squareful: then there is some prime that occurs more
+ ;; than once in its factorization. Choosing this prime as the divisor for
+ ;; the formula gives us d+(n/d). We know that n/d will still be divisible
+ ;; by d, because we chose a d that occurs multiple times in the
+ ;; factorization. Obviously d itself is divisible by d. Thus our entire
+ ;; formula is divisible by d, and so not prime.
+ ;;
+ ;; Unfortunately this doesn't really help us much, because there's no
+ ;; efficient way to tell if a number is squarefree (see
+ ;; http://mathworld.wolfram.com/Squarefree.html).
+ ;;
+ ;; * We only have to check d <= sqrt(n).
+ ;;
+ ;; For each divisor d of n we know there's a twin divisor d' such that
+ ;; d * d' = n (that's what it MEANS for d to be a divisor of n).
+ ;;
+ ;; If we plug d into the formula we have d + n/d.
+ ;; We know that n/d = d', and so we have d + d'.
+ ;;
+ ;; If we plug d' into the formula we have d' + n/d'.
+ ;; We know that n/d' = d, and so we have d' + d.
+ ;;
+ ;; This means that plugging d or d' into the formula both result in the
+ ;; same number, so we only need to bother checking one of them.
+ (1+ (iterate
+ ;; edge case: skip 2 (candidiate 1), we'll add it at the end
+ (for prime :in-vector (sieve (1+ 100000000)) :from 1)
+ (for candidate = (1- prime))
+ (when (and (check-divisor candidate 2)
+ (prime-generating-integer-p candidate))
+ (summing candidate))))))
+
+
+;;;; Tests --------------------------------------------------------------------
+(def-suite :euler)
+(in-suite :euler)
+
+(test p1 (is (= 233168 (problem-1))))
+(test p2 (is (= 4613732 (problem-2))))
+(test p3 (is (= 6857 (problem-3))))
+(test p4 (is (= 906609 (problem-4))))
+(test p5 (is (= 232792560 (problem-5))))
+(test p6 (is (= 25164150 (problem-6))))
+(test p7 (is (= 104743 (problem-7))))
+(test p8 (is (= 23514624000 (problem-8))))
+(test p9 (is (= 31875000 (problem-9))))
+(test p10 (is (= 142913828922 (problem-10))))
+(test p11 (is (= 70600674 (problem-11))))
+(test p12 (is (= 76576500 (problem-12))))
+(test p13 (is (= 5537376230 (problem-13))))
+(test p14 (is (= 837799 (problem-14))))
+(test p15 (is (= 137846528820 (problem-15))))
+(test p16 (is (= 1366 (problem-16))))
+(test p17 (is (= 21124 (problem-17))))
+(test p18 (is (= 1074 (problem-18))))
+(test p19 (is (= 171 (problem-19))))
+(test p20 (is (= 648 (problem-20))))
+(test p21 (is (= 31626 (problem-21))))
+(test p22 (is (= 871198282 (problem-22))))
+(test p23 (is (= 4179871 (problem-23))))
+(test p24 (is (= 2783915460 (problem-24))))
+(test p25 (is (= 4782 (problem-25))))
+(test p26 (is (= 983 (problem-26))))
+(test p27 (is (= -59231 (problem-27))))
+(test p28 (is (= 669171001 (problem-28))))
+(test p29 (is (= 9183 (problem-29))))
+(test p30 (is (= 443839 (problem-30))))
+(test p31 (is (= 73682 (problem-31))))
+(test p32 (is (= 45228 (problem-32))))
+(test p33 (is (= 100 (problem-33))))
+(test p34 (is (= 40730 (problem-34))))
+(test p35 (is (= 55 (problem-35))))
+(test p36 (is (= 872187 (problem-36))))
+(test p37 (is (= 748317 (problem-37))))
+(test p38 (is (= 932718654 (problem-38))))
+(test p39 (is (= 840 (problem-39))))
+(test p40 (is (= 210 (problem-40))))
+(test p41 (is (= 7652413 (problem-41))))
+(test p42 (is (= 162 (problem-42))))
+(test p43 (is (= 16695334890 (problem-43))))
+(test p44 (is (= 5482660 (problem-44))))
+(test p45 (is (= 1533776805 (problem-45))))
+(test p46 (is (= 5777 (problem-46))))
+(test p47 (is (= 134043 (problem-47))))
+(test p48 (is (= 9110846700 (problem-48))))
+(test p49 (is (= 296962999629 (problem-49))))
+(test p50 (is (= 997651 (problem-50))))
+(test p51 (is (= 121313 (problem-51))))
+(test p52 (is (= 142857 (problem-52))))
+(test p53 (is (= 4075 (problem-53))))
+(test p54 (is (= 376 (problem-54))))
+(test p55 (is (= 249 (problem-55))))
+(test p56 (is (= 972 (problem-56))))
+(test p57 (is (= 153 (problem-57))))
+(test p58 (is (= 26241 (problem-58))))
+(test p59 (is (= 107359 (problem-59))))
+(test p60 (is (= 26033 (problem-60))))
+(test p61 (is (= 28684 (problem-61))))
+(test p62 (is (= 127035954683 (problem-62))))
+(test p63 (is (= 49 (problem-63))))
+
+
+(test p74 (is (= 402 (problem-74))))
+(test p79 (is (= 73162890 (problem-79))))
+(test p92 (is (= 8581146 (problem-92))))
+(test p145 (is (= 608720 (problem-145))))
+(test p357 (is (= 1739023853137 (problem-357))))
+
+
+(defun run-tests ()
+ (run! :euler))
--- a/src/utils.lisp Wed Aug 09 14:55:51 2017 -0400
+++ b/src/utils.lisp Thu Aug 10 20:09:14 2017 -0400
@@ -470,3 +470,42 @@
(every (lambda (el)
(setf p (position el haystack :start p :key key :test test)))
needles)))))
+
+
+(deftype matrix (&optional (element-type '*))
+ `(array ,element-type (* *)))
+
+(defun transpose-matrix (matrix)
+ (check-type matrix matrix)
+ (iterate (with (rows cols) = (array-dimensions matrix))
+ (with result = (make-array (list cols rows)))
+ (for-nested ((i :from 0 :below rows)
+ (j :from 0 :below cols)))
+ (setf (aref result j i)
+ (aref matrix i j))
+ (finally (return result))))
+
+(defun rotate-matrix-clockwise (matrix)
+ (check-type matrix matrix)
+ (iterate (with (rows cols) = (array-dimensions matrix))
+ (with result = (make-array (list cols rows)))
+ (for source-row :from 0 :below rows)
+ (for target-col = (- rows source-row 1))
+ (dotimes (source-col cols)
+ (for target-row = source-col)
+ (setf (aref result target-row target-col)
+ (aref matrix source-row source-col)))
+ (finally (return result))))
+
+(defun rotate-matrix-counterclockwise (matrix)
+ (check-type matrix matrix)
+ (iterate (with (rows cols) = (array-dimensions matrix))
+ (with result = (make-array (list cols rows)))
+ (for source-row :from 0 :below rows)
+ (for target-col = source-row)
+ (dotimes (source-col cols)
+ (for target-row = (- cols source-col 1))
+ (setf (aref result target-row target-col)
+ (aref matrix source-row source-col)))
+ (finally (return result))))
+
--- a/vendor/make-quickutils.lisp Wed Aug 09 14:55:51 2017 -0400
+++ b/vendor/make-quickutils.lisp Thu Aug 10 20:09:14 2017 -0400
@@ -5,6 +5,7 @@
:utilities '(
:compose
+ :copy-array
:curry
:define-constant
:emptyp
--- a/vendor/quickutils.lisp Wed Aug 09 14:55:51 2017 -0400
+++ b/vendor/quickutils.lisp Thu Aug 10 20:09:14 2017 -0400
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :EMPTYP :ENSURE-BOOLEAN :ENSURE-FUNCTION :ENSURE-GETHASH :EQUIVALENCE-CLASSES :MAP-COMBINATIONS :MAP-PERMUTATIONS :MAXF :MINF :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-ARRAY :CURRY :DEFINE-CONSTANT :EMPTYP :ENSURE-BOOLEAN :ENSURE-FUNCTION :ENSURE-GETHASH :EQUIVALENCE-CLASSES :MAP-COMBINATIONS :MAP-PERMUTATIONS :MAXF :MINF :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "EULER.QUICKUTILS")
@@ -14,13 +14,13 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :COMPOSE :CURRY :DEFINE-CONSTANT
- :NON-ZERO-P :EMPTYP :ENSURE-BOOLEAN
- :ENSURE-GETHASH :EQUIVALENCE-CLASSES
- :MAP-COMBINATIONS :MAP-PERMUTATIONS
- :MAXF :MINF :TAKE :N-GRAMS :RANGE
- :RCURRY :ONCE-ONLY :WITH-OPEN-FILE*
- :WITH-INPUT-FROM-FILE
+ :COMPOSE :COPY-ARRAY :CURRY
+ :DEFINE-CONSTANT :NON-ZERO-P :EMPTYP
+ :ENSURE-BOOLEAN :ENSURE-GETHASH
+ :EQUIVALENCE-CLASSES :MAP-COMBINATIONS
+ :MAP-PERMUTATIONS :MAXF :MINF :TAKE
+ :N-GRAMS :RANGE :RCURRY :ONCE-ONLY
+ :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
:READ-FILE-INTO-STRING :REMOVEF
:STRING-DESIGNATOR :WITH-GENSYMS
:EXTRACT-FUNCTION-NAME :SWITCH))))
@@ -77,6 +77,24 @@
,(compose-1 funs))))))
+ (defun copy-array (array &key (element-type (array-element-type array))
+ (fill-pointer (and (array-has-fill-pointer-p array)
+ (fill-pointer array)))
+ (adjustable (adjustable-array-p array)))
+ "Returns an undisplaced copy of `array`, with same `fill-pointer` and
+adjustability (if any) as the original, unless overridden by the keyword
+arguments."
+ (let* ((dimensions (array-dimensions array))
+ (new-array (make-array dimensions
+ :element-type element-type
+ :adjustable adjustable
+ :fill-pointer fill-pointer)))
+ (dotimes (i (array-total-size array))
+ (setf (row-major-aref new-array i)
+ (row-major-aref array i)))
+ new-array))
+
+
(defun curry (function &rest arguments)
"Returns a function that applies `arguments` and the arguments
it is called with to `function`."
@@ -526,8 +544,8 @@
(generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose curry define-constant emptyp ensure-boolean ensure-function
- ensure-gethash equivalence-classes map-combinations
+ (export '(compose copy-array curry define-constant emptyp ensure-boolean
+ ensure-function ensure-gethash equivalence-classes map-combinations
map-permutations maxf minf n-grams range rcurry
read-file-into-string removef switch eswitch cswitch with-gensyms
with-unique-names)))