Difference between revisions of "Euler problems/91 to 100"
m |
|||
(8 intermediate revisions by 6 users not shown) | |||
Line 1: | Line 1: | ||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=91 Problem 91] == |
Find the number of right angle triangles in the quadrant. |
Find the number of right angle triangles in the quadrant. |
||
Line 19: | Line 19: | ||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=92 Problem 92] == |
Investigating a square digits number chain with a surprising property. |
Investigating a square digits number chain with a surprising property. |
||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
+ | import Data.Array |
||
+ | import Data.Char |
||
import Data.List |
import Data.List |
||
+ | makeIncreas 1 minnum = [[a]|a<-[minnum..9]] |
||
− | import Data.Map(fromList,(!)) |
||
+ | makeIncreas digits minnum = [a:b|a<-[minnum ..9],b<-makeIncreas (digits-1) a] |
||
− | pow2=[a*a|a<-[0..9]] |
||
+ | squares :: Array Char Int |
||
− | sum_pow 1=0 |
||
+ | squares = array ('0','9') [ (intToDigit x,x^2) | x <- [0..9] ] |
||
− | sum_pow 89=1 |
||
+ | |||
− | sum_pow x= sum_pow(sum [pow2 !! y |y<-digits x]) |
||
+ | next :: Int -> Int |
||
− | sumMap=fromList[(k, |
||
+ | next = sum . map (squares !) . show |
||
− | fromList[(i,sum_pow ki) |
||
+ | factorial n = if n == 0 then 1 else n * factorial (n - 1) |
||
− | |i<-[0..1000], |
||
+ | countNum xs=ys |
||
− | let ki=k*1000+i |
||
− | + | where |
|
+ | ys=product$map (factorial.length)$group xs |
||
− | k<-[0..400] |
||
+ | yield :: Int -> Int |
||
+ | yield = until (\x -> x == 89 || x == 1) next |
||
+ | problem_92= |
||
+ | sum[div p7 $countNum a| |
||
+ | a<-tail$makeIncreas 7 0, |
||
+ | let k=sum $map (^2) a, |
||
+ | yield k==89 |
||
] |
] |
||
− | fastsumpow x |
||
− | |x<400000=sumMap!d!m |
||
− | |otherwise=fastsumpow(sum [pow2 !! y |y<-digits x]) |
||
where |
where |
||
− | + | p7=factorial 7 |
|
− | digits n |
||
− | {- change 123 to [3,2,1] |
||
− | -} |
||
− | |n<10=[n] |
||
− | |otherwise= y:digits x |
||
− | where |
||
− | (x,y)=divMod n 10 |
||
− | groups=100000 |
||
− | problem_92 b=sum [fastsumpow a|a<-[1+b*groups..groups+b*groups]] |
||
− | google num |
||
− | =if (num>99) |
||
− | then return() |
||
− | else do let lst=[show$problem_92 num ," ",(show num),"\n"] |
||
− | appendFile "files.log" $foldl (++) "" lst |
||
− | google (num+1) |
||
− | main=google 0 |
||
− | split :: Char -> String -> [String] |
||
− | split = unfoldr . split' |
||
− | |||
− | split' :: Char -> String -> Maybe (String, String) |
||
− | split' c l |
||
− | | null l = Nothing |
||
− | | otherwise = Just (h, drop 1 t) |
||
− | where (h, t) = span (/=c) l |
||
− | sToInt x=((+0).read) $head$split ' ' x |
||
− | problem_92a=do |
||
− | x<-readFile "files.log" |
||
− | print $sum$map sToInt $lines x |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=93 Problem 93] == |
Using four distinct digits and the rules of arithmetic, find the longest sequence of target numbers. |
Using four distinct digits and the rules of arithmetic, find the longest sequence of target numbers. |
||
Line 79: | Line 57: | ||
import Data.List |
import Data.List |
||
import Control.Monad |
import Control.Monad |
||
+ | import Data.Ord (comparing) |
||
solve [] [x] = [x] |
solve [] [x] = [x] |
||
Line 103: | Line 82: | ||
|otherwise=n-1 |
|otherwise=n-1 |
||
− | cmp |
+ | cmp = comparing results |
main = |
main = |
||
Line 116: | Line 95: | ||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=94 Problem 94] == |
Investigating almost equilateral triangles with integral sides and area. |
Investigating almost equilateral triangles with integral sides and area. |
||
Line 147: | Line 126: | ||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=95 Problem 95] == |
Find the smallest member of the longest amicable chain with no element exceeding one million. |
Find the smallest member of the longest amicable chain with no element exceeding one million. |
||
− | |||
− | Solution which avoid visiting a number more than one time : |
||
− | <haskell> |
||
− | import Data.Array.Unboxed |
||
− | import qualified Data.IntSet as S |
||
− | import Data.List |
||
− | |||
− | takeUntil _ [] = [] |
||
− | takeUntil pred (x:xs) = x : if pred x then takeUntil pred xs else [] |
||
− | |||
− | chain n s = lgo [n] $ properDivisorsSum ! n |
||
− | where lgo xs x | x > 1000000 || S.notMember x s = (xs,[]) |
||
− | | x `elem` xs = (xs,x : takeUntil (/= x) xs) |
||
− | | otherwise = lgo (x:xs) $ properDivisorsSum ! x |
||
− | |||
− | properDivisorsSum :: UArray Int Int |
||
− | properDivisorsSum = accumArray (+) 1 (0,1000000) |
||
− | $ (0,-1):[(k,factor)| |
||
− | factor<-[2..1000000 `div` 2] |
||
− | , k<-[2*factor,2*factor+factor..1000000] |
||
− | ] |
||
− | |||
− | base = S.fromList [1..1000000] |
||
− | |||
− | problem_95 = fst $ until (S.null . snd) f ((0,0),base) |
||
− | where |
||
− | f (p@(n,m), s) = (p', s') |
||
− | where |
||
− | setMin = head $ S.toAscList s |
||
− | (explored, chn) = chain setMin s |
||
− | len = length chn |
||
− | p' = if len > m then (minimum chn, len) else p |
||
− | s' = foldl' (flip S.delete) s explored |
||
− | </haskell> |
||
− | ---- |
||
Here is a more straightforward solution, without optimization. |
Here is a more straightforward solution, without optimization. |
||
Yet it solves the problem in a few seconds when |
Yet it solves the problem in a few seconds when |
||
Line 195: | Line 139: | ||
<haskell> |
<haskell> |
||
import Data.List (foldl1', group) |
import Data.List (foldl1', group) |
||
− | merge xs@(x:xt) ys@(y:yt) = case compare x y of |
||
− | LT -> x : (merge xt ys) |
||
− | EQ -> x : (merge xt yt) |
||
− | GT -> y : (merge xs yt) |
||
− | |||
− | diff xs@(x:xt) ys@(y:yt) = case compare x y of |
||
− | LT -> x : (diff xt ys) |
||
− | EQ -> diff xt yt |
||
− | GT -> diff xs yt |
||
− | |||
− | primes = [2,3,5] ++ (diff [7,9..] nonprimes) |
||
− | nonprimes = foldr1 f . map g $ tail primes |
||
− | where f (x:xt) ys = x : (merge xt ys) |
||
− | g p = [ n*p | n <- [p,p+2..]] |
||
− | fstfac x = [(head a ,length a)|a<-group$primeFactors x] |
||
− | -- The sum of all proper divisors of n. |
||
− | sumDivi m = |
||
− | product [div (a^(n+1)-1) (a-1)| |
||
− | (a,n)<-fstfac m |
||
− | ]-m |
||
− | |||
− | primeFactors = pf primes |
||
− | where |
||
− | pf ps@(p:ps') n |
||
− | | p * p > n = [n] |
||
− | | r == 0 = p : pf ps q |
||
− | | otherwise = pf ps' n |
||
− | where |
||
− | (q, r) = n `divMod` p |
||
Line 236: | Line 151: | ||
| (< n') 1000000 = [] |
| (< n') 1000000 = [] |
||
| n' `elem` s = [] |
| n' `elem` s = [] |
||
− | | otherwise = chain(n' : s) n $ |
+ | | otherwise = chain(n' : s) n $ eulerTotient n' |
− | findChain n = length$chain [] n $ |
+ | findChain n = length$chain [] n $ eulerTotient n |
longestChain = |
longestChain = |
||
foldl1' cmpChain [(n, findChain n) | n <- [12496..15000]] |
foldl1' cmpChain [(n, findChain n) | n <- [12496..15000]] |
||
Line 244: | Line 159: | ||
| (k, negate n) < (k', negate n') = q |
| (k, negate n) < (k', negate n') = q |
||
| otherwise = p |
| otherwise = p |
||
− | problem_95 = fst$longestChain |
+ | problem_95 = fst $ longestChain |
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=96 Problem 96] == |
Devise an algorithm for solving Su Doku puzzles. |
Devise an algorithm for solving Su Doku puzzles. |
||
Line 306: | Line 221: | ||
loop :: [Grid] -> [Grid] |
loop :: [Grid] -> [Grid] |
||
− | loop |
+ | loop = concatMap extrapolate |
− | loop xs = concat . map extrapolate $ xs |
||
solve :: Grid -> Grid |
solve :: Grid -> Grid |
||
Line 324: | Line 238: | ||
filter ((/='G') . head) . |
filter ((/='G') . head) . |
||
lines $ contents |
lines $ contents |
||
− | let rgrids=map ( |
+ | let rgrids=map (concatMap words) grids |
writeFile "p96.log"$show$ sum $ map (top3 . solve) $ rgrids |
writeFile "p96.log"$show$ sum $ map (top3 . solve) $ rgrids |
||
problem_96 =main |
problem_96 =main |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=97 Problem 97] == |
Find the last ten digits of the non-Mersenne prime: 28433 × 2<sup>7830457</sup> + 1. |
Find the last ten digits of the non-Mersenne prime: 28433 × 2<sup>7830457</sup> + 1. |
||
Solution: |
Solution: |
||
<haskell> |
<haskell> |
||
− | mulMod :: Integral a => a -> a -> a -> a |
||
− | mulMod a b c= (b * c) `rem` a |
||
− | squareMod :: Integral a => a -> a -> a |
||
− | squareMod a b = (b * b) `rem` a |
||
− | pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a |
||
− | pow' _ _ _ 0 = 1 |
||
− | pow' mul sq x' n' = f x' n' 1 |
||
− | where |
||
− | f x n y |
||
− | | n == 1 = x `mul` y |
||
− | | r == 0 = f x2 q y |
||
− | | otherwise = f x2 q (x `mul` y) |
||
− | where |
||
− | (q,r) = quotRem n 2 |
||
− | x2 = sq x |
||
− | powMod :: Integral a => a -> a -> a -> a |
||
− | powMod m = pow' (mulMod m) (squareMod m) |
||
problem_97 = |
problem_97 = |
||
flip mod limit $ 28433 * powMod limit 2 7830457 + 1 |
flip mod limit $ 28433 * powMod limit 2 7830457 + 1 |
||
Line 356: | Line 253: | ||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=98 Problem 98] == |
Investigating words, and their anagrams, which can represent square numbers. |
Investigating words, and their anagrams, which can represent square numbers. |
||
Line 363: | Line 260: | ||
import Data.List |
import Data.List |
||
import Data.Maybe |
import Data.Maybe |
||
+ | import Data.Function (on) |
||
-- Replace each letter of a word, or digit of a number, with |
-- Replace each letter of a word, or digit of a number, with |
||
Line 373: | Line 271: | ||
-- Check for equality on the first component of a tuple |
-- Check for equality on the first component of a tuple |
||
fstEq :: Eq a => (a, b) -> (a, b) -> Bool |
fstEq :: Eq a => (a, b) -> (a, b) -> Bool |
||
− | fstEq |
+ | fstEq = (==) `on` fst |
-- The histogram of a small list |
-- The histogram of a small list |
||
Line 415: | Line 313: | ||
-- Sort on length of first element, from longest to shortest |
-- Sort on length of first element, from longest to shortest |
||
longFirst :: [[a]] -> [[a]] -> Ordering |
longFirst :: [[a]] -> [[a]] -> Ordering |
||
− | longFirst |
+ | longFirst = flip compareLen `on` fst |
-- Is y longer than x? |
-- Is y longer than x? |
||
Line 423: | Line 321: | ||
-- Compare the lengths of lists, with short-circuiting |
-- Compare the lengths of lists, with short-circuiting |
||
compareLen :: [a] -> [a] -> Ordering |
compareLen :: [a] -> [a] -> Ordering |
||
− | compareLen (_:xs) |
+ | compareLen (_:xs) (_:ys) = compareLen xs ys |
+ | compareLen (_:_) [] = GT |
||
− | _ -> GT |
||
− | compareLen |
+ | compareLen [] [] = EQ |
− | compareLen |
+ | compareLen [] (_:_) = LT |
</haskell> |
</haskell> |
||
+ | (Cf. [[short-circuiting]]) |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=99 Problem 99] == |
Which base/exponent pair in the file has the greatest numerical value? |
Which base/exponent pair in the file has the greatest numerical value? |
||
Line 435: | Line 334: | ||
<haskell> |
<haskell> |
||
import Data.List |
import Data.List |
||
+ | lognum (b,e) = e * log b |
||
− | split :: Char -> String -> [String] |
||
+ | logfun x = lognum . read $ "(" ++ x ++ ")" |
||
− | split = unfoldr . split' |
||
+ | problem_99 = snd . maximum . flip zip [1..] . map logfun . lines |
||
− | |||
+ | main = readFile "base_exp.txt" >>= print . problem_99 |
||
− | split' :: Char -> String -> Maybe (String, String) |
||
− | split' c l |
||
− | | null l = Nothing |
||
− | | otherwise = Just (h, drop 1 t) |
||
− | where (h, t) = span (/=c) l |
||
− | lognum [a, b]=b*log a |
||
− | logfun x=lognum$map ((+0).read) $split ',' x |
||
− | problem_99 file = |
||
− | head$map fst $ sortBy (\(_,a) (_,b) -> compare b a) $ |
||
− | zip [1..] $map logfun $lines file |
||
− | main=do |
||
− | f<-readFile "base_exp.txt" |
||
− | print$problem_99 f |
||
</haskell> |
</haskell> |
||
− | == [http://projecteuler.net/index.php?section= |
+ | == [http://projecteuler.net/index.php?section=problems&id=100 Problem 100] == |
Finding the number of blue discs for which there is 50% chance of taking two blue. |
Finding the number of blue discs for which there is 50% chance of taking two blue. |
||
Latest revision as of 20:08, 21 February 2010
Problem 91
Find the number of right angle triangles in the quadrant.
Solution:
reduce x y = (quot x d, quot y d)
where d = gcd x y
problem_91 n =
3*n*n + 2* sum others
where
others =[min xc yc|
x1 <- [1..n],
y1 <- [1..n],
let (yi,xi) = reduce x1 y1,
let yc = quot (n-y1) yi,
let xc = quot x1 xi
]
Problem 92
Investigating a square digits number chain with a surprising property.
Solution:
import Data.Array
import Data.Char
import Data.List
makeIncreas 1 minnum = [[a]|a<-[minnum..9]]
makeIncreas digits minnum = [a:b|a<-[minnum ..9],b<-makeIncreas (digits-1) a]
squares :: Array Char Int
squares = array ('0','9') [ (intToDigit x,x^2) | x <- [0..9] ]
next :: Int -> Int
next = sum . map (squares !) . show
factorial n = if n == 0 then 1 else n * factorial (n - 1)
countNum xs=ys
where
ys=product$map (factorial.length)$group xs
yield :: Int -> Int
yield = until (\x -> x == 89 || x == 1) next
problem_92=
sum[div p7 $countNum a|
a<-tail$makeIncreas 7 0,
let k=sum $map (^2) a,
yield k==89
]
where
p7=factorial 7
Problem 93
Using four distinct digits and the rules of arithmetic, find the longest sequence of target numbers.
Solution:
import Data.List
import Control.Monad
import Data.Ord (comparing)
solve [] [x] = [x]
solve ns stack =
pushes ++ ops
where
pushes = do
x <- ns
solve (x `delete` ns) (x:stack)
ops = do
guard (length stack > 1)
x <- opResults (stack!!0) (stack!!1)
solve ns (x : drop 2 stack)
opResults a b =
[a*b,a+b,a-b] ++ (if b /= 0 then [a / b] else [])
results xs = fun 1 ys
where
ys = nub $ sort $ map truncate $
filter (\x -> x > 0 && floor x == ceiling x) $ solve xs []
fun n (x:xs)
|n == x =fun (n+1) xs
|otherwise=n-1
cmp = comparing results
main =
appendFile "p93.log" $ show $
maximumBy cmp $ [[a,b,c,d] |
a <- [1..10],
b <- [a+1..10],
c <- [b+1..10],
d <- [c+1..10]
]
problem_93 = main
Problem 94
Investigating almost equilateral triangles with integral sides and area.
Solution:
import List
findmin d = d:head [[n,m]|m<-[1..10],n<-[1..10],n*n==d*m*m+1]
pow 1 x=x
pow n x =mult x $pow (n-1) x
where
mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1]
--find it looks like (5-5-6)
f556 =takeWhile (<10^9)
[n2|i<-[1..],
let [_,m,_]=pow i$findmin 12,
let n=div (m-1) 6,
let n1=4*n+1, -- sides
let n2=3*n1+1 -- perimeter
]
--find it looks like (5-6-6)
f665 =takeWhile (<10^9)
[n2|i<-[1..],
let [_,m,_]=pow i$findmin 3,
mod (m-2) 3==0,
let n=div (m-2) 3,
let n1=2*n,
let n2=3*n1+2
]
problem_94=sum f556+sum f665-2
Problem 95
Find the smallest member of the longest amicable chain with no element exceeding one million. Here is a more straightforward solution, without optimization. Yet it solves the problem in a few seconds when compiled with GHC 6.6.1 with the -O2 flag. I like to let the compiler do the optimization, without cluttering my code.
This solution avoids using unboxed arrays, which many consider to be somewhat of an imperitive-style hack. In fact, no memoization at all is required.
import Data.List (foldl1', group)
-- The longest chain of numbers is (n, k), where
-- n is the smallest number in the chain, and k is the length
-- of the chain. We limit the search to chains whose
-- smallest number is no more than m and, optionally, whose
-- largest number is no more than m'.
chain s n n'
| n' == n = s
| n' < n = []
| (< n') 1000000 = []
| n' `elem` s = []
| otherwise = chain(n' : s) n $ eulerTotient n'
findChain n = length$chain [] n $ eulerTotient n
longestChain =
foldl1' cmpChain [(n, findChain n) | n <- [12496..15000]]
where
cmpChain p@(n, k) q@(n', k')
| (k, negate n) < (k', negate n') = q
| otherwise = p
problem_95 = fst $ longestChain
Problem 96
Devise an algorithm for solving Su Doku puzzles.
See numerous solutions on the Sudoku page.
import Data.List
import Char
top3 :: Grid -> Int
top3 g =
read . take 3 $ (g !! 0)
type Grid = [String]
type Row = String
type Col = String
type Cell = String
type Pos = Int
row :: Grid -> Pos -> Row
row [] _ = []
row g p = filter (/='0') (g !! (p `div` 9))
col :: Grid -> Pos -> Col
col [] _ = []
col g p = filter (/='0') ((transpose g) !! (p `mod` 9))
cell :: Grid -> Pos -> Cell
cell [] _ = []
cell g p =
concat rows
where
r = p `div` 9 `div` 3 * 3
c = p `mod` 9 `div` 3 * 3
rows =
map (take 3 . drop c) . map (g !!) $ [r, r+1, r+2]
groupsOf _ [] = []
groupsOf n xs =
front : groupsOf n back
where
(front,back) = splitAt n xs
extrapolate :: Grid -> [Grid]
extrapolate [] = []
extrapolate g =
if null zeroes
then [] -- no more zeroes, must have solved it
else map mkGrid possibilities
where
flat = concat g
numbered = zip [0..] flat
zeroes = filter ((=='0') . snd) numbered
p = fst . head $ zeroes
possibilities =
['1'..'9'] \\ (row g p ++ col g p ++ cell g p)
(front,_:back) = splitAt p flat
mkGrid new = groupsOf 9 (front ++ [new] ++ back)
loop :: [Grid] -> [Grid]
loop = concatMap extrapolate
solve :: Grid -> Grid
solve g =
head .
last .
takeWhile (not . null) .
iterate loop $ [g]
main = do
contents <- readFile "sudoku.txt"
let
grids :: [Grid]
grids =
groupsOf 9 .
filter ((/='G') . head) .
lines $ contents
let rgrids=map (concatMap words) grids
writeFile "p96.log"$show$ sum $ map (top3 . solve) $ rgrids
problem_96 =main
Problem 97
Find the last ten digits of the non-Mersenne prime: 28433 × 27830457 + 1.
Solution:
problem_97 =
flip mod limit $ 28433 * powMod limit 2 7830457 + 1
where
limit=10^10
Problem 98
Investigating words, and their anagrams, which can represent square numbers.
Solution:
import Data.List
import Data.Maybe
import Data.Function (on)
-- Replace each letter of a word, or digit of a number, with
-- the index of where that letter or digit first appears
profile :: Ord a => [a] -> [Int]
profile x = map (fromJust . flip lookup (indices x)) x
where
indices = map head . groupBy fstEq . sort . flip zip [0..]
-- Check for equality on the first component of a tuple
fstEq :: Eq a => (a, b) -> (a, b) -> Bool
fstEq = (==) `on` fst
-- The histogram of a small list
hist :: Ord a => [a] -> [(a, Int)]
hist = let item g = (head g, length g) in map item . group . sort
-- The list of anagram sets for a word list.
anagrams :: Ord a => [[a]] -> [[[a]]]
anagrams x = map (map snd) $ filter (not . null . drop 1) $
groupBy fstEq $ sort $ zip (map hist x) x
-- Given two finite lists that are a permutation of one
-- another, return the permutation function
mkPermute :: Ord a => [a] -> [a] -> ([b] -> [b])
mkPermute x y = pairsToPermute $ concat $
zipWith zip (occurs x) (occurs y)
where
pairsToPermute ps = flip map (map snd $ sort ps) . (!!)
occurs = map (map snd) . groupBy fstEq . sort . flip zip [0..]
problem_98 :: [String] -> Int
problem_98 ws = read $ head
[y | was <- sortBy longFirst $ anagrams ws, -- word anagram sets
w1:t <- tails was, w2 <- t,
let permute = mkPermute w1 w2,
nas <- sortBy longFirst $ anagrams $
filter ((== profile w1) . profile) $
dropWhile (flip longerThan w1) $
takeWhile (not . longerThan w1) $
map show $ map (\x -> x * x) [1..], -- number anagram sets
x:t <- tails nas, y <- t,
permute x == y || permute y == x
]
run_problem_98 :: IO Int
run_problem_98 = do
words_file <- readFile "words.txt"
let words = read $ '[' : words_file ++ "]"
return $ problem_98 words
-- Sort on length of first element, from longest to shortest
longFirst :: [[a]] -> [[a]] -> Ordering
longFirst = flip compareLen `on` fst
-- Is y longer than x?
longerThan :: [a] -> [a] -> Bool
longerThan x y = compareLen x y == LT
-- Compare the lengths of lists, with short-circuiting
compareLen :: [a] -> [a] -> Ordering
compareLen (_:xs) (_:ys) = compareLen xs ys
compareLen (_:_) [] = GT
compareLen [] [] = EQ
compareLen [] (_:_) = LT
(Cf. short-circuiting)
Problem 99
Which base/exponent pair in the file has the greatest numerical value?
Solution:
import Data.List
lognum (b,e) = e * log b
logfun x = lognum . read $ "(" ++ x ++ ")"
problem_99 = snd . maximum . flip zip [1..] . map logfun . lines
main = readFile "base_exp.txt" >>= print . problem_99
Problem 100
Finding the number of blue discs for which there is 50% chance of taking two blue.
Solution:
nextAB a b
|a+b>10^12 =[a,b]
|otherwise=nextAB (3*a+2*b+2) (4*a+3*b+3)
problem_100=(+1)$head$nextAB 14 20