# Euler problems/91 to 100

### From HaskellWiki

(Euler problem 91) |
(Added problem_95_v2) |
||

Line 78: | Line 78: | ||

p' = if len > m then (minimum chn, len) else p | p' = if len > m then (minimum chn, len) else p | ||

s' = foldl' (flip S.delete) s explored | s' = foldl' (flip S.delete) s explored | ||

+ | </haskell> | ||

+ | ---- | ||

+ | Here is a more straightforward solution, without optimization. | ||

+ | Yet it solves the problem in a few seconds when | ||

+ | compiled with GHC 6.6.1 with the -O2 flag. I like to let | ||

+ | the compiler do the optimization, without cluttering my code. | ||

+ | |||

+ | This solution avoids using unboxed arrays, which many consider to be | ||

+ | somewhat of an imperitive-style hack. In fact, no memoization | ||

+ | at all is required. | ||

+ | |||

+ | <haskell> | ||

+ | import Data.List (foldl1', group) | ||

+ | |||

+ | -- The sum of all proper divisors of n. | ||

+ | d n = product [(p * product g - 1) `div` (p - 1) | | ||

+ | g <- group $ primeFactors n, let p = head g | ||

+ | ] - n | ||

+ | |||

+ | primeFactors = pf primes | ||

+ | where | ||

+ | pf ps@(p:ps') n | ||

+ | | p * p > n = [n] | ||

+ | | r == 0 = p : pf ps q | ||

+ | | otherwise = pf ps' n | ||

+ | where | ||

+ | (q, r) = n `divMod` p | ||

+ | |||

+ | primes = 2 : filter (null . tail . primeFactors) [3,5..] | ||

+ | |||

+ | -- The longest chain of numbers is (n, k), where | ||

+ | -- n is the smallest number in the chain, and k is the length | ||

+ | -- of the chain. We limit the search to chains whose | ||

+ | -- smallest number is no more than m and, optionally, whose | ||

+ | -- largest number is no more than m'. | ||

+ | longestChain m m' = (n, k) | ||

+ | where | ||

+ | (n, Just k) = foldl1' cmpChain [(n, findChain n) | n <- [2..m]] | ||

+ | findChain n = f [] n $ d n | ||

+ | f s n n' | ||

+ | | n' == n = Just $ 1 + length s | ||

+ | | n' < n = Nothing | ||

+ | | maybe False (< n') m' = Nothing | ||

+ | | n' `elem` s = Nothing | ||

+ | | otherwise = f (n' : s) n $ d n' | ||

+ | cmpChain p@(n, k) q@(n', k') | ||

+ | | (k, negate n) < (k', negate n') = q | ||

+ | | otherwise = p | ||

+ | |||

+ | problem_95_v2 = longestChain 1000000 (Just 1000000) | ||

</haskell> | </haskell> | ||

## Revision as of 10:20, 20 September 2007

## Contents |

## 1 Problem 91

Find the number of right angle triangles in the quadrant.

Solution:

reduce x y = (quot x d, quot y d) where d = gcd x y problem_91 n = 3*n*n + 2* sum others where others = do x1 <- [1..n] y1 <- [1..n] let (yi,xi) = reduce x1 y1 let yc = quot (n-y1) yi let xc = quot x1 xi return (min xc yc)

## 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 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

Here is a more straightforward solution, without optimization. Yet it solves the problem in a few seconds when compiled with GHC 6.6.1 with the -O2 flag. I like to let the compiler do the optimization, without cluttering my code.

This solution avoids using unboxed arrays, which many consider to be somewhat of an imperitive-style hack. In fact, no memoization at all is required.

import Data.List (foldl1', group) -- The sum of all proper divisors of n. d n = product [(p * product g - 1) `div` (p - 1) | g <- group $ primeFactors n, let p = head g ] - n primeFactors = pf primes where pf ps@(p:ps') n | p * p > n = [n] | r == 0 = p : pf ps q | otherwise = pf ps' n where (q, r) = n `divMod` p primes = 2 : filter (null . tail . primeFactors) [3,5..] -- The longest chain of numbers is (n, k), where -- n is the smallest number in the chain, and k is the length -- of the chain. We limit the search to chains whose -- smallest number is no more than m and, optionally, whose -- largest number is no more than m'. longestChain m m' = (n, k) where (n, Just k) = foldl1' cmpChain [(n, findChain n) | n <- [2..m]] findChain n = f [] n $ d n f s n n' | n' == n = Just $ 1 + length s | n' < n = Nothing | maybe False (< n') m' = Nothing | n' `elem` s = Nothing | otherwise = f (n' : s) n $ d n' cmpChain p@(n, k) q@(n', k') | (k, negate n) < (k', negate n') = q | otherwise = p problem_95_v2 = longestChain 1000000 (Just 1000000)

## 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