Difference between revisions of "Euler problems/101 to 110"
Jump to navigation
Jump to search
(add problem_107) |
Marypoppins (talk | contribs) |
||
| Line 1: | Line 1: | ||
| + | Do them on your own! |
||
| − | == [http://projecteuler.net/index.php?section=problems&id=101 Problem 101] == |
||
| − | 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> |
||
Revision as of 21:45, 29 January 2008
Do them on your own!