Personal tools

Euler problems/101 to 110

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 125: Line 125:
 
(x,y)=divMod n 2
 
(x,y)=divMod n 2
 
subset lst=
 
subset lst=
[delzero t|
+
[sl|
 
n<-[0..2^len-1],
 
n<-[0..2^len-1],
 
let a=digitstwo n len,
 
let a=digitstwo n len,
let t=zip lst a
+
sum a<=mlen,
  +
let t=zip lst a,
  +
let sl=delzero t
 
]
 
]
 
where
 
where
 
len=length lst
 
len=length lst
  +
mlen= div len 2
 
delzero x=[a|(a,b)<-x,b/=0]
 
delzero x=[a|(a,b)<-x,b/=0]
notEqu lst=
+
notEqu lst su=
 
length sm ==(length.nub) sm
 
length sm ==(length.nub) sm
 
where
 
where
su=subset lst
 
 
sm=[sum a|a<-su]
 
sm=[sum a|a<-su]
moreElem lst=
+
moreElem lst =
foldl (&&) True [k|a<-su,let len=length a,let k=sum a>maE!!len]
+
foldl (&&) True maE
 
where
 
where
 
le=length lst
 
le=length lst
su=subset lst
+
sortLst=sort lst
maxsum su a=maximum[sum b|b<-su,length b==a]
+
maxElem =
maxElem lst = (-1):0:[maxsum su a|a<-[1..le-1]]++[sum lst]
+
(-1):[sum $drop (le-a) sortLst|
maE=maxElem lst
+
a<-[0..le]
  +
]
  +
minElem =
  +
[sum $take a sortLst|
  +
a<-[0..le]
  +
]
  +
maE=[a<b|(a,b)<-zip maxElem minElem]
 
buildTriangle s = map read (splitRegex (mkRegex ",") s) :: [Integer]
 
buildTriangle s = map read (splitRegex (mkRegex ",") s) :: [Integer]
 
problem_105=do
 
problem_105=do
 
x<-readFile "sets.txt"
 
x<-readFile "sets.txt"
let sm=[a|a<-map buildTriangle $ lines x,notEqu a]
+
let sm=
let me=[a|a<-sm,moreElem a]
+
[a|
print $sum$concat me
+
a<-map buildTriangle $ lines x,
  +
moreElem a ,
  +
notEqu a $subset a
  +
]
  +
print $sum$concat sm
 
</haskell>
 
</haskell>
   

Revision as of 12:44, 14 January 2008

Contents

1 Problem 101

Investigate the optimum polynomial function to model the first k terms of a given sequence.

Solution:

problem_101 = undefined

2 Problem 102

For how many triangles in the text file does the interior contain the origin?

Solution:

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

3 Problem 103

Investigating sets with a special subset sum property.

Solution:

six=[11,18,19,20,22,25]
seven=[mid+a|let mid=six!!3,a<-0:six]
problem_103=foldl (++) "" $map show seven

4 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

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

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.

5 Problem 105

Find the sum of the special sum sets in the file.

Solution:

import List
import Text.Regex 
--ghc -M p105.hs
digitstwo n k
    |k==0=[]
    |otherwise= y:digitstwo x (k-1)
    where
    (x,y)=divMod n 2
subset lst=
    [sl|
    n<-[0..2^len-1],
    let a=digitstwo n len,
    sum a<=mlen,
    let t=zip lst a,
    let sl=delzero t
    ]
    where
    len=length lst
    mlen= div len 2
    delzero x=[a|(a,b)<-x,b/=0]
notEqu lst su=
    length sm ==(length.nub) sm
    where
    sm=[sum a|a<-su]
moreElem lst =
    foldl (&&) True  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]
buildTriangle s = map read (splitRegex (mkRegex ",") s) :: [Integer] 
problem_105=do
    x<-readFile "sets.txt"
    let sm=
         [a|
         a<-map  buildTriangle $ lines x,
         moreElem a ,
         notEqu a $subset a
         ]
    print $sum$concat sm

6 Problem 106

Find the minimum number of comparisons needed to identify special sum sets.

Solution:

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

7 Problem 107

Determining the most efficient way to connect the network.

Solution:

problem_107 = undefined

8 Problem 108

Solving the Diophantine equation 1/x + 1/y = 1/n.

Solution:

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

9 Problem 109

How many distinct ways can a player checkout in the game of darts with a score of less than 100?

Solution:

problem_109 = undefined

10 Problem 110

Find an efficient algorithm to analyse the number of solutions of the equation 1/x + 1/y = 1/n.

Solution:

-- prob in problem_108
problem_110 = prob 13 (8*10^6)