Euler problems/101 to 110

From HaskellWiki
< Euler problems
Revision as of 09:16, 7 January 2008 by Lisp (talk | contribs)

Jump to: navigation, search

Problem 101

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

Solution:

problem_101 = undefined

Problem 102

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

Solution:

import List

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
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)
sToInt x=map ((+0).read) $split ',' x
problem_102=do
    x<-readFile "triangles.txt"
    print $length$ filter isOrig$map sToInt $lines x

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

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.

Problem 105

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

Solution:

import List
digitstwo n k
    |k==0=[]
    |otherwise= y:digitstwo x (k-1)
    where
    (x,y)=divMod n 2
subset lst=
    [delzero t|
    n<-[0..2^len-1],
    let a=digitstwo n len,
    let t=zip lst a
    ]
    where
    len=length lst
    delzero x=[a|(a,b)<-x,b/=0]
notEqu lst=
    length sm ==(length.nub) sm
    where
    su=subset lst
    sm=[sum a|a<-su]
moreElem lst=
    foldl (&&) True  [k|a<-su,let len=length a,let k=sum a>maE!!len]
    where
    le=length lst
    su=subset lst
    maxsum su a=maximum[sum b|b<-su,length b==a]
    maxElem lst = (-1):0:[maxsum su a|a<-[1..le-1]]++[sum lst]
    maE=maxElem lst
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=map ((+0).read) $split ',' x
problem_105=do
    x<-readFile "sets.txt"
    let sm=[a|a<-map sToInt $lines x,notEqu a]
    let me=[a|a<-sm,moreElem a]
    print $sum$concat me

Problem 106

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

Solution:

problem_106 = undefined

Problem 107

Determining the most efficient way to connect the network.

Solution:

problem_107 = undefined

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

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

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)