# Euler problems/91 to 100

### From HaskellWiki

m (Corrected the links to Project Euler) |
(Solution for problem 94, not the best but still good (I think)) |
||

Line 35: | Line 35: | ||

Find the smallest member of the longest amicable chain with no element exceeding one million. |
Find the smallest member of the longest amicable chain with no element exceeding one million. |
||

− | Solution: |
+ | Solution which avoid visiting a number more than one time : |

<haskell> |
<haskell> |
||

− | problem_95 = undefined |
+ | import Data.Array.Unboxed |

+ | import Prime |
||

+ | import qualified Data.IntSet as S |
||

+ | import Data.List |
||

+ | |||

+ | chain n s = lgo [n] $ properDivisorsSum ! n |
||

+ | where lgo xs x | x > 1000000 || S.notMember x s = (xs,[]) |
||

+ | | x `elem` xs = (xs,x : takeWhile (/= 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 ((n,m), s) = ((n',m'), s') |
||

+ | where setMin = head $ S.toAscList s |
||

+ | (explored, chn) = chain setMin s |
||

+ | len = length chn |
||

+ | (n',m') = if len > m |
||

+ | then (minimum chn, len) |
||

+ | else (n,m) |
||

+ | 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 14:57, 30 August 2007

## Contents |

## 1 Problem 91

Find the number of right angle triangles in the quadrant.

Solution:

problem_91 = undefined

## 2 Problem 92

Investigating a square digits number chain with a surprising property.

Solution:

problem_92 = undefined

## 3 Problem 93

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

Solution:

problem_93 = undefined

## 4 Problem 94

Investigating almost equilateral triangles with integral sides and area.

Solution:

problem_94 = undefined

## 5 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 Prime import qualified Data.IntSet as S import Data.List chain n s = lgo [n] $ properDivisorsSum ! n where lgo xs x | x > 1000000 || S.notMember x s = (xs,[]) | x `elem` xs = (xs,x : takeWhile (/= 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 ((n,m), s) = ((n',m'), s') where setMin = head $ S.toAscList s (explored, chn) = chain setMin s len = length chn (n',m') = if len > m then (minimum chn, len) else (n,m) s' = foldl' (flip S.delete) s explored

This solution need some space in its stack (it worked with 30M here).

## 6 Problem 96

Devise an algorithm for solving Su Doku puzzles.

Solution:

problem_96 = undefined

## 7 Problem 97

Find the last ten digits of the non-Mersenne prime: 28433 × 2^{7830457} + 1.

Solution:

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

## 8 Problem 98

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

Solution:

problem_98 = undefined

## 9 Problem 99

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

Solution:

problem_99 = undefined

## 10 Problem 100

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

Solution:

problem_100 = undefined