Euler problems/91 to 100

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)

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

---

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)

Problem 96

Devise an algorithm for solving Su Doku puzzles.

See numerous solutions on the Sudoku page.

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)

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