|
|
Line 1: |
Line 1: |
− | == [http://projecteuler.net/index.php?section=problems&id=101 Problem 101] ==
| + | Do them on your own! |
− | Investigate the optimum polynomial function to model the first k terms of a given sequence.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | problem_101 = undefined
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=102 Problem 102] ==
| |
− | For how many triangles in the text file does the interior contain the origin?
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | import Text.Regex
| |
− | --ghc -M p102.hs
| |
− | isOrig (x1:y1:x2:y2:x3:y3:[])=
| |
− | t1*t2>=0 && t3*t4>=0 && t5*t6>=0
| |
− | where
| |
− | x4=0
| |
− | y4=0
| |
− | t1=(y2-y1)*(x4-x1)+(x1-x2)*(y4-y1)
| |
− | t2=(y2-y1)*(x3-x1)+(x1-x2)*(y3-y1)
| |
− | t3=(y3-y1)*(x4-x1)+(x1-x3)*(y4-y1)
| |
− | t4=(y3-y1)*(x2-x1)+(x1-x3)*(y2-y1)
| |
− | t5=(y3-y2)*(x4-x2)+(x2-x3)*(y4-y2)
| |
− | t6=(y3-y2)*(x1-x2)+(x2-x3)*(y1-y2)
| |
− | buildTriangle s = map read (splitRegex (mkRegex ",") s) :: [Integer]
| |
− | problem_102=do
| |
− | x<-readFile "triangles.txt"
| |
− | let y=map buildTriangle$lines x
| |
− | print $length$ filter isOrig y
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=103 Problem 103] ==
| |
− | Investigating sets with a special subset sum property.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | six=[11,18,19,20,22,25]
| |
− | seven=[mid+a|let mid=six!!3,a<-0:six]
| |
− | problem_103=foldl (++) "" $map show seven
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=104 Problem 104] ==
| |
− | Finding Fibonacci numbers for which the first and last nine digits are pandigital.
| |
− | | |
− | Solution:
| |
− | | |
− | Very nice problem. I didnt realize you could deal with the precision problem.
| |
− | Therefore I used this identity to speed up the fibonacci calculation:
| |
− | f_(2*n+k)
| |
− | = f_k*(f_(n+1))^2
| |
− | + 2*f_(k-1)*f_(n+1)*f_n
| |
− | + f_(k-2)*(f_n)^2
| |
− | | |
− | <haskell>
| |
− | import Data.List
| |
− | import Data.Char
| |
− |
| |
− | fibos = rec 0 1
| |
− | where
| |
− | rec a b = a:rec b (a+b)
| |
− |
| |
− | fibo_2nk n k =
| |
− | let
| |
− | fkm1 = fibo (k-1)
| |
− | fkm2 = fibo (k-2)
| |
− | fk = fkm1 + fkm2
| |
− | fnp1 = fibo (n+1)
| |
− | fnp1sq = fnp1^2
| |
− | fn = fibo n
| |
− | fnsq = fn^2
| |
− | in
| |
− | fk*fnp1sq + 2*fkm1*fnp1*fn + fkm2*fnsq
| |
− |
| |
− | fibo x =
| |
− | let
| |
− | threshold = 30000
| |
− | n = div x 3
| |
− | k = n+mod x 3
| |
− | in
| |
− | if x < threshold
| |
− | then fibos !! x
| |
− | else fibo_2nk n k
| |
− |
| |
− | findCandidates = rec 0 1 0
| |
− | where
| |
− | m = 10^9
| |
− | rec a b n =
| |
− | let
| |
− | continue = rec b (mod (a+b) m) (n+1)
| |
− | isBackPan a = (sort $ show a) == "123456789"
| |
− | in
| |
− | if isBackPan a
| |
− | then n:continue
| |
− | else continue
| |
− | search =
| |
− | let
| |
− | isFrontPan x = (sort $ take 9 $ show x) == "123456789"
| |
− | in
| |
− | map fst
| |
− | $ take 1
| |
− | $ dropWhile (not.snd)
| |
− | $ zip findCandidates
| |
− | $ map (isFrontPan.fibo) findCandidates
| |
− |
| |
− | problem_104 = search
| |
− | </haskell>
| |
− | It took 8 sec on a 2.2Ghz machine.
| |
− | | |
− | The lesson I learned fom this challenge, is: know mathematical identities and exploit them. They allow you take short cuts.
| |
− | Normally you compute all previous fibonacci numbers to compute a random fibonacci number. Which has linear costs. The aforementioned identity builds the number not from its two predecessors but from 4 much smaller ones. This makes the algorithm logarithmic in its complexity. It really shines if you want to compute a random very large fibonacci number. f.i. the 10mio.th fibonacci number which is over 2mio characters long, took 20sec to compute on my 2.2ghz laptop.
| |
− | == [http://projecteuler.net/index.php?section=problems&id=105 Problem 105] ==
| |
− | Find the sum of the special sum sets in the file.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | import Data.List
| |
− | import Control.Monad
| |
− | import Text.Regex
| |
− |
| |
− | solNum=map solve [7..12]
| |
− | solve n = twoSetsOf [0..n-1] =<< [2..div n 2]
| |
− | twoSetsOf xs n = do
| |
− | firstSet <- setsOf n xs
| |
− | let rest = dropWhile (/= head firstSet) xs \\ firstSet
| |
− | secondSet <- setsOf n rest
| |
− | let f = firstSet >>= enumFromTo 1
| |
− | s = secondSet >>= enumFromTo 1
| |
− | guard $ not $ null (f \\ s) || null (s \\ f)
| |
− | [(firstSet,secondSet)]
| |
− | | |
− | setsOf 0 _ = [[]]
| |
− | setsOf (n+1) xs = concat [map (y:) (setsOf n ys) | (y:ys) <- tails xs]
| |
− | comp lst a b=
| |
− | a1/=b1
| |
− | where
| |
− | a1=sum$map (lst!!) a
| |
− | b1=sum$map (lst!!) b
| |
− | notEqu lst =
| |
− | all id[comp slst a b|(a,b)<-solNum!!s]
| |
− | where
| |
− | s=length lst-7
| |
− | slst=sort lst
| |
− | moreElem lst =
| |
− | all id maE
| |
− | where
| |
− | le=length lst
| |
− | sortLst=sort lst
| |
− | maxElem =
| |
− | (-1):[sum $drop (le-a) sortLst|
| |
− | a<-[0..le]
| |
− | ]
| |
− | minElem =
| |
− | [sum $take a sortLst|
| |
− | a<-[0..le]
| |
− | ]
| |
− | maE=[a<b|(a,b)<-zip maxElem minElem]
| |
− | stoInt s=map read (splitRegex (mkRegex ",") s) :: [Integer]
| |
− | check x=moreElem x && notEqu x
| |
− | main = do
| |
− | f <- readFile "sets.txt"
| |
− | let sets = map stoInt$ lines f
| |
− | let ssets = filter check sets
| |
− | print $ sum $ concat ssets
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=106 Problem 106] ==
| |
− | Find the minimum number of comparisons needed to identify special sum sets.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | binomial x y =div (prodxy (y+1) x) (prodxy 1 (x-y))
| |
− | prodxy x y=product[x..y]
| |
− | -- http://mathworld.wolfram.com/DyckPath.html
| |
− | catalan n=flip div (n+1) $binomial (2*n) n
| |
− | calc n=
| |
− | sum[e*(c-d)|
| |
− | a<-[1..di2],
| |
− | let mu2=a*2,
| |
− | let c=flip div 2 $ binomial mu2 a,
| |
− | let d=catalan a,
| |
− | let e=binomial n mu2]
| |
− | where
| |
− | di2=div n 2
| |
− | problem_106 = calc 12
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=107 Problem 107] ==
| |
− | Determining the most efficient way to connect the network.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | import Control.Monad.ST
| |
− | import Control.Monad
| |
− | import Data.Array.MArray
| |
− | import Data.Array.ST
| |
− | import Data.List
| |
− | import Data.Map (fromList,(!))
| |
− | import Text.Regex
| |
− | makeArr x=map zero (splitRegex (mkRegex ",") x)
| |
− | makeNet x lst y=[((a,b),m)|a<-[0..x-1],b<-[0..a-1],let m=lst!!a!!b,m/=y]
| |
− | zero x
| |
− | |'-' `elem` x=0
| |
− | |otherwise=read x::Int
| |
− | problem_107 =do
| |
− | a<-readFile "network.txt"
| |
− | let b=map makeArr $lines a
| |
− | network = makeNet 40 b 0
| |
− | edges = sortBy (\x y->compare (snd x) (snd y)) network
| |
− | eedges =map fst edges
| |
− | mape=fromList edges
| |
− | d=sum $ map snd edges
| |
− | e=sum$map (mape!)$kruskal eedges
| |
− | print (d-e)
| |
− | kruskal es = runST ( do
| |
− | let hi = maximum $ map (uncurry max) es
| |
− | lo = minimum $ map (uncurry min) es
| |
− | djs <- makeDjs (lo,hi)
| |
− | filterM (kruskalST djs) es)
| |
− |
| |
− | kruskalST djs (u,v) = do
| |
− | disjoint <- djsDisjoint u v djs
| |
− | when disjoint $ djsUnion u v djs
| |
− | return disjoint
| |
− |
| |
− | type DisjointSet s = STArray s Int (Maybe Int)
| |
− |
| |
− | makeDjs :: (Int,Int) -> ST s (DisjointSet s)
| |
− | makeDjs b = newArray b Nothing
| |
− | | |
− | djsUnion a b djs = do
| |
− | root <- djsFind a djs
| |
− | writeArray djs root $ Just b
| |
− | | |
− | djsFind a djs = maybe (return a) f =<< readArray djs a
| |
− | where f p = do p' <- djsFind p djs
| |
− | writeArray djs a (Just p')
| |
− | return p'
| |
− |
| |
− | djsDisjoint a b uf = liftM2 (/=) (djsFind a uf) (djsFind b uf)
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=108 Problem 108] ==
| |
− | Solving the Diophantine equation 1/x + 1/y = 1/n.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | import List
| |
− | primes=[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73]
| |
− | series _ 1 =[[0]]
| |
− | series xs n =[x:ps|x<-xs,ps<-series [0..x] (n-1) ]
| |
− | distinct=product. map (+1)
| |
− | sumpri x=product $map (\(x,y)->x^y)$zip primes x
| |
− | prob x y =head$sort[(sumpri m ,m)|m<-series [1..3] x,(>y)$distinct$map (*2) m]
| |
− | problem_108=prob 7 2000
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=109 Problem 109] ==
| |
− | How many distinct ways can a player checkout in the game of darts with a score of less than 100?
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | problem_109 = undefined
| |
− | </haskell>
| |
− | | |
− | == [http://projecteuler.net/index.php?section=problems&id=110 Problem 110] ==
| |
− | Find an efficient algorithm to analyse the number of solutions of the equation 1/x + 1/y = 1/n.
| |
− | | |
− | Solution:
| |
− | <haskell>
| |
− | -- prob in problem_108
| |
− | problem_110 = prob 13 (8*10^6)
| |
− | </haskell>
| |