aboutsummaryrefslogtreecommitdiff
path: root/haskell
diff options
context:
space:
mode:
Diffstat (limited to 'haskell')
-rw-r--r--haskell/wip/011-largest_product_in_a_grid.hs72
-rw-r--r--haskell/wip/012-highly_divisible_triangular_number.hs44
-rw-r--r--haskell/wip/021-amicable_numbers.hs31
-rw-r--r--haskell/wip/023-non_abundant_sum.hs57
-rw-r--r--haskell/wip/030-digit_fifth_powers.hs30
-rw-r--r--haskell/wip/044-pentagonal_numbers.hs19
6 files changed, 253 insertions, 0 deletions
diff --git a/haskell/wip/011-largest_product_in_a_grid.hs b/haskell/wip/011-largest_product_in_a_grid.hs
new file mode 100644
index 0000000..75f1db0
--- /dev/null
+++ b/haskell/wip/011-largest_product_in_a_grid.hs
@@ -0,0 +1,72 @@
+-- Largest product in a grid
+--
+-- Problem 11
+-- In the 20×20 grid below, four numbers along a diagonal line have been marked in red.
+--
+-- 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
+--
+-- 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?
+
+
+main = do
+ -- print (largest_product grid)
+ print grid
+
+largest_product :: [[Int]] -> Int
+largest_product g = maximum [largest_row, largest_col, largest_diag]
+ where largest_row = 3
+ largest_col = 3
+ largest_diag = 3
+
+max4 :: [Int] -> Int
+max4 [x] = x
+max4 (x:xs) = max (sum (take 4 (x:xs))) (max4 xs)
+
+
+
+
+
+grid :: [[Int]]
+grid = map (map read) (map words (lines grid_str))
+grid_str = "08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08\n\
+ \49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00\n\
+ \81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65\n\
+ \52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91\n\
+ \22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80\n\
+ \24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50\n\
+ \32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70\n\
+ \67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21\n\
+ \24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72\n\
+ \21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95\n\
+ \78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92\n\
+ \16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57\n\
+ \86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58\n\
+ \19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40\n\
+ \04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66\n\
+ \88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69\n\
+ \04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36\n\
+ \20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16\n\
+ \20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54\n\
+ \01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48"
diff --git a/haskell/wip/012-highly_divisible_triangular_number.hs b/haskell/wip/012-highly_divisible_triangular_number.hs
new file mode 100644
index 0000000..ad621b0
--- /dev/null
+++ b/haskell/wip/012-highly_divisible_triangular_number.hs
@@ -0,0 +1,44 @@
+-- Highly divisible triangular number
+
+-- 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?
+
+
+main = do
+ print (trial_division 2 10)
+ print (find_triangular 1)
+
+
+find_triangular :: Int -> Int
+find_triangular n
+ | trial_division 2 nth_triangular > 100 = nth_triangular
+ | otherwise = find_triangular (n + 1)
+ where nth_triangular = (n * (n + 1)) `div` 2
+
+trial_division :: Int -> Int -> Int
+trial_division by x
+ | x == 0 || by > x = 2
+ | x `mod` by == 0 = 1 + trial_division by (x `div` by)
+ | otherwise = trial_division (by + 1) x
+
+-- naive
+-- triangulars :: Int -> [Int]
+-- triangulars 0 = []
+-- triangulars i = sum [1..i] : triangulars (i - 1)
diff --git a/haskell/wip/021-amicable_numbers.hs b/haskell/wip/021-amicable_numbers.hs
new file mode 100644
index 0000000..867765d
--- /dev/null
+++ b/haskell/wip/021-amicable_numbers.hs
@@ -0,0 +1,31 @@
+-- Amicable numbers
+--
+-- 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.
+
+
+-- 5s isnt pretty, divSum is probably the root of evil
+main = print (sum $ map fst (filterAmicable [2..10000]))
+
+filterAmicable :: [Int] -> [(Int, Int)]
+filterAmicable xs = filter (\(n, s) -> n /= s && any ((==)(s, n)) sums) sums
+ where sums = [(x, divSum x) | x <- xs]
+
+divSum :: Int -> Int
+divSum n = factorise 2
+ where factorise d
+ | d > nSqrt = 1
+ | rest == 0 && d /= quotient = d + quotient + factorise (d + 1)
+ | rest == 0 && d == quotient = quotient + factorise (d + 1)
+ | otherwise = factorise (d + 1)
+ where quotient = n `div` d
+ rest = n `mod` d
+ nSqrt = floor $ sqrt $ fromIntegral n
diff --git a/haskell/wip/023-non_abundant_sum.hs b/haskell/wip/023-non_abundant_sum.hs
new file mode 100644
index 0000000..d519eb6
--- /dev/null
+++ b/haskell/wip/023-non_abundant_sum.hs
@@ -0,0 +1,57 @@
+-- Non-abundant sums
+--
+-- 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.
+
+
+import Data.List(nub)
+
+main = do
+ -- print (nub [n | n <- [1..28123], a <- abundants, a < n, n - a `notElem` abundants])
+ -- print ([n | n <- [1..2812], notAbundantSum n])
+ print (length filteredMultiples)
+ -- print ([n | n <- filteredMultiples, notAbundantSum n])
+ -- print (combkk
+
+
+
+filteredMultiples = filter (\n -> n `notElem` abundantsMultiples) [1..20161]
+abundantsMultiples = [a * x | a <- abundants, x <- [2..1700], a * x < 20161]
+
+notAbundantSum :: Int -> Bool
+notAbundantSum x
+ | x > 28123= False
+ | otherwise = findAbSum 0
+ where findAbSum i
+ | curr > x - 12 || i == length abundants = True
+ | (x - curr) `elem` abundants = False
+ | otherwise = findAbSum (i + 1)
+ where curr = abundants !! i
+
+abundants = [n | n <- [1..28123], divSum n > n]
+
+divSum :: Int -> Int
+divSum n = factorise 2
+ where factorise d
+ | d > nSqrt = 1
+ | rest == 0 && d /= quotient = d + quotient + factorise (d + 1)
+ | rest == 0 && d == quotient = quotient + factorise (d + 1)
+ | otherwise = factorise (d + 1)
+ where quotient = n `div` d
+ rest = n `mod` d
+ nSqrt = floor $ sqrt $ fromIntegral n
diff --git a/haskell/wip/030-digit_fifth_powers.hs b/haskell/wip/030-digit_fifth_powers.hs
new file mode 100644
index 0000000..6cc8a49
--- /dev/null
+++ b/haskell/wip/030-digit_fifth_powers.hs
@@ -0,0 +1,30 @@
+-- Digit fifth powers
+--
+-- Problem 30
+-- Surprisingly there are only three numbers that can be written as the sum of fourth
+-- powers of their digits:
+--
+-- 1634 = 14 + 64 + 34 + 44
+-- 8208 = 84 + 24 + 04 + 84
+-- 9474 = 94 + 44 + 74 + 44
+-- As 1 = 14 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.
+
+
+main = do
+ print ( [x0 + x1 * 10 + x2 * 100 + x3 * 1000 |
+ x0 <- [0..9], x1 <- [0..9], x2 <- [0..9], x3 <- [1..9],
+ (sum $ map (^4) [x0, x1, x2, x3])
+ == x0 + x1 * 10 + x2 * 100 + x3 * 1000])
+
+ print ( [x0 + x1 * 10 + x2 * 100 + x3 * 1000 + x4 * 10000 |
+ x0 <- [0..9], x1 <- [0..9], x2 <- [0..9], x3 <- [0..9], x4 <- [1..9],
+ (sum $ map (^5) [x0, x1, x2, x3, x4])
+ == x0 + x1 * 10 + x2 * 100 + x3 * 1000 + x4 * 10000])
+
+-- allPower :: Int -> [Int]
+-- allPower
diff --git a/haskell/wip/044-pentagonal_numbers.hs b/haskell/wip/044-pentagonal_numbers.hs
new file mode 100644
index 0000000..966cc13
--- /dev/null
+++ b/haskell/wip/044-pentagonal_numbers.hs
@@ -0,0 +1,19 @@
+-- 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?
+
+
+main = do
+ -- print (take 10 pentagonals)
+ let isPentagonal n = n `elem` takeWhile (<=n) pentagonals
+ pentagonals = [(3 * n ^ 2 - n) `div` 2 | n <- [1..]]
+ print (head [j + k| k <- pentagonals, j <- pentagonals,
+ isPentagonal (j + k)]) --, isPentagonal (abs (j - k))])
+
generated by cgit (git 2.34.1) at 2026-05-16 11:31:49 +0000