haskell problem 22, 24, 25, 29, 39, 40, 45, 53, 59

9 files changed, 232 insertions, 0 deletions

diff --git a/haskell/022-names_scores.hs b/haskell/022-names_scores.hs
new file mode 100644
index 0000000..dd91ac8
--- /dev/null
+++ b/haskell/022-names_scores.hs
@@ -0,0 +1,24 @@
+-- Names scores
+--
+-- Problem 22
+-- Using names.txt (right click and 'Save Link/Target As...'), 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?
+
+
+import Data.Char(ord)
+import Data.List(sort)
+
+main = do
+    content <- readFile "../data/022_names.txt"
+    let nameSum name = sum [ord c - ord 'A' + 1 | c <- name]
+        names = sort $ words $ foldr
+            (\c acc -> (if c `elem` "\"," then ' ' else c) : acc) "" content
+    print (sum [nameSum n * i | (n, i) <- zip (names) [1..]])
diff --git a/haskell/024-lexicographic_premutations.hs b/haskell/024-lexicographic_premutations.hs
new file mode 100644
index 0000000..5db0aaa
--- /dev/null
+++ b/haskell/024-lexicographic_premutations.hs
@@ -0,0 +1,21 @@
+-- Lexicographic permutations
+--
+-- 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?
+
+
+import Data.Char(chr,ord)
+
+main = print (foldr (\x acc -> chr (ord '0' + x) : acc) "" ((permutations' [0..9]) !! 999999))
+
+permutations' :: [Int] -> [[Int]]
+permutations' [x] = [[x]]
+permutations' xs = concat [[x : p | p <-  permutations' (filter (x/=) xs)] | x <- xs]
diff --git a/haskell/025-1000_digit_fibonacci_number.hs b/haskell/025-1000_digit_fibonacci_number.hs
new file mode 100644
index 0000000..969d09e
--- /dev/null
+++ b/haskell/025-1000_digit_fibonacci_number.hs
@@ -0,0 +1,28 @@
+-- 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?
+
+
+main = print (length $ takeWhile (\x -> x `div` 10 ^ 999 == 0) fibs)
+
+-- thanks to you, random german video
+-- found this: https://wiki.haskell.org/The_Fibonacci_sequence
+fibs :: [Integer]
+fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
diff --git a/haskell/029-distinct_powers.hs b/haskell/029-distinct_powers.hs
new file mode 100644
index 0000000..132ffe0
--- /dev/null
+++ b/haskell/029-distinct_powers.hs
@@ -0,0 +1,17 @@
+-- Consider all integer combinations of a^b for 2 ≤ a ≤ 5 and 2 ≤ b ≤ 5:
+--
+-- 2^2=4, 2^3=8, 2^4=16, 2^5=32
+-- 3^2=9, 3^3=27, 3^4=81, 3^5=243
+-- 4^2=16, 4^3=64, 4^4=256, 4^5=1024
+-- 5^2=25, 5^3=125, 5^4=625, 5^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 ab for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?
+
+
+import Data.List (nub)
+
+main = print (length $ nub [a ^ b | a <- [2..100], b <- [2..100]])
diff --git a/haskell/039-interger_right_triangle.hs b/haskell/039-interger_right_triangle.hs
new file mode 100644
index 0000000..fda5eb9
--- /dev/null
+++ b/haskell/039-interger_right_triangle.hs
@@ -0,0 +1,24 @@
+-- Integer right triangles
+--
+-- 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?
+
+
+import Data.List(maximumBy)
+
+-- 4m20s stucks
+main = do
+    print (maximumBy (\(_, xs) (_, ys) -> compare (length xs) (length ys)) [
+                (p,
+                [(a, b, p - a - b) | a <- [1..p], b <- [1..(p-a)],
+                validRightTriangle a b (p - a - b)])
+            | p <- [1..1000]
+          ])
+
+validRightTriangle :: Int -> Int -> Int -> Bool
+validRightTriangle a b c = a ^ 2 + b ^ 2 == c ^ 2
diff --git a/haskell/040-champernowne_s_constant.hs b/haskell/040-champernowne_s_constant.hs
new file mode 100644
index 0000000..59cb1b4
--- /dev/null
+++ b/haskell/040-champernowne_s_constant.hs
@@ -0,0 +1,22 @@
+-- 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
+
+
+-- main = print (1 + sum [9 * 10 ^ i | i <- [0..5]])
+main = do
+    print (product [champernowne !! (10 ^ i - 1) | i <- [0..6]])
+
+champernowne = concat [showNbr n | n <- [1..]]
+
+showNbr :: Integer -> [Integer]
+showNbr x
+    | x < 10 = [x]
+    | otherwise = showNbr (x `div` 10) ++ [x `mod` 10]
diff --git a/haskell/045-triangular_pentagonal_and_hexgonal.hs b/haskell/045-triangular_pentagonal_and_hexgonal.hs
new file mode 100644
index 0000000..e04f8c3
--- /dev/null
+++ b/haskell/045-triangular_pentagonal_and_hexgonal.hs
@@ -0,0 +1,19 @@
+-- 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.
+
+
+-- 30s is kinda okay (not really)
+main = do
+    let triangle = [n * (n + 1) `div` 2 | n <- [1..]]
+        pentagonal = [n * (3 * n - 1) `div` 2 | n <- [1..]]
+        hexagonal = [n * (2 * n - 1) | n <- [1..]]
+        isPentagonal n = n `elem` takeWhile (<= n) pentagonal
+        isHexagonal n = n `elem` takeWhile (<= n) hexagonal
+    print (take 2 [t | t <- drop 284 triangle, isPentagonal t, isHexagonal t])
+
diff --git a/haskell/053-combinatoric_selections.hs b/haskell/053-combinatoric_selections.hs
new file mode 100644
index 0000000..0fc1211
--- /dev/null
+++ b/haskell/053-combinatoric_selections.hs
@@ -0,0 +1,19 @@
+-- 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?
+
+
+main = do
+    print (length [pascal n r | n <- [1..100], r <- [1..n], pascal n r > 1000000])
+
+pascal :: Integer -> Integer -> Integer
+pascal _ 0 = 1
+pascal n k = (pascal n (k - 1)) * (n + 1 - k) `div` k
diff --git a/haskell/059-xor_decryption.hs b/haskell/059-xor_decryption.hs
new file mode 100644
index 0000000..9a2bbe7
--- /dev/null
+++ b/haskell/059-xor_decryption.hs
@@ -0,0 +1,58 @@
+-- XOR decryption
+--
+-- 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 p059_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.
+
+
+import Data.Bits(xor)
+import Data.Char(ord, chr)
+import qualified Data.Map as M
+
+type Frequencies = M.Map Char Int
+
+main = do
+    content <- readFile "../data/059_cipher.txt"
+    let formatted = map (\s -> read s :: Int) $
+            (words $ map (\c -> if c == ',' then ' 'else c) content)
+    let freqs = [((applyKey k formatted), frequency $ applyKey k formatted) | k <- keys]
+        filtered = filterEnglish freqs
+    print (sum (fst $ filtered !! 1))
+
+filterEnglish :: [(a, Frequencies)] -> [(a, Frequencies)]
+filterEnglish fs = filter (\(t, f) -> filt_ea (M.lookup 'e' f)) fs
+    where filt_ea Nothing = False
+          filt_ea (Just freq) = freq > 10
+
+keys = [[ord a, ord b, ord c] | a <- low, b <- low, c <- low]
+    where low = ['a'..'z']
+
+applyKey :: [Int] -> [Int] -> [Int]
+applyKey key code = zipWith (xor) (cycle key) code
+
+frequency :: [Int] -> Frequencies
+frequency code = M.map (\v -> v * 100 `div` length code) counter
+    where counter = M.fromListWith (+) (map (\c -> (chr c, 1)) code)