Difference between revisions of "Euler problems/91 to 100"

From HaskellWiki
Jump to navigation Jump to search
m
m
Line 52: Line 52:
 
properDivisorsSum = accumArray (+) 1 (0,1000000)
 
properDivisorsSum = accumArray (+) 1 (0,1000000)
 
$ (0,-1):[(k,factor)|
 
$ (0,-1):[(k,factor)|
factor<-[2..1000000 `div` 2]
+
factor<-[2..1000000 `div` 2]
, k<-[2*factor,2*factor+factor..1000000]
+
, k<-[2*factor,2*factor+factor..1000000]
]
+
]
   
 
base = S.fromList [1..1000000]
 
base = S.fromList [1..1000000]
Line 68: Line 68:
 
s' = foldl' (flip S.delete) s explored
 
s' = foldl' (flip S.delete) s explored
 
</haskell>
 
</haskell>
This solution need some space in its stack (it worked with 30M here).
 
   
 
== [http://projecteuler.net/index.php?section=view&id=96 Problem 96] ==
 
== [http://projecteuler.net/index.php?section=view&id=96 Problem 96] ==

Revision as of 15:08, 30 August 2007

Problem 91

Find the number of right angle triangles in the quadrant.

Solution:

problem_91 = undefined

Problem 92

Investigating a square digits number chain with a surprising property.

Solution:

problem_92 = undefined

Problem 93

Using four distinct digits and the rules of arithmetic, find the longest sequence of target numbers.

Solution:

problem_93 = undefined

Problem 94

Investigating almost equilateral triangles with integral sides and area.

Solution:

problem_94 = undefined

Problem 95

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 :

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

Problem 96

Devise an algorithm for solving Su Doku puzzles.

Solution:

problem_96 = undefined

Problem 97

Find the last ten digits of the non-Mersenne prime: 28433 × 27830457 + 1.

Solution:

problem_97 = (28433 * 2^7830457 + 1) `mod` (10^10)

Problem 98

Investigating words, and their anagrams, which can represent square numbers.

Solution:

problem_98 = undefined

Problem 99

Which base/exponent pair in the file has the greatest numerical value?

Solution:

problem_99 = undefined

Problem 100

Finding the number of blue discs for which there is 50% chance of taking two blue.

Solution:

problem_100 = undefined