Personal tools

Euler problems/151 to 160

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=151 Problem 151] ==
+
== [http://projecteuler.net/index.php?section=problems&id=151 Problem 151] ==
 
Paper sheets of standard sizes: an expected-value problem.
 
Paper sheets of standard sizes: an expected-value problem.
   
Line 7: Line 7:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=152 Problem 152] ==
+
== [http://projecteuler.net/index.php?section=problems&id=152 Problem 152] ==
 
Writing 1/2 as a sum of inverse squares
 
Writing 1/2 as a sum of inverse squares
   
Line 80: Line 80:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=153 Problem 153] ==
+
== [http://projecteuler.net/index.php?section=problems&id=153 Problem 153] ==
 
Investigating Gaussian Integers
 
Investigating Gaussian Integers
   
Line 88: Line 88:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=154 Problem 154] ==
+
== [http://projecteuler.net/index.php?section=problems&id=154 Problem 154] ==
 
Exploring Pascal's pyramid.
 
Exploring Pascal's pyramid.
   
Line 96: Line 96:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=155 Problem 155] ==
+
== [http://projecteuler.net/index.php?section=problems&id=155 Problem 155] ==
 
Counting Capacitor Circuits.
 
Counting Capacitor Circuits.
   
Line 104: Line 104:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=156 Problem 156] ==
+
== [http://projecteuler.net/index.php?section=problems&id=156 Problem 156] ==
 
Counting Digits
 
Counting Digits
   
Line 112: Line 112:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=157 Problem 157] ==
+
== [http://projecteuler.net/index.php?section=problems&id=157 Problem 157] ==
 
Solving the diophantine equation 1/a+1/b= p/10n
 
Solving the diophantine equation 1/a+1/b= p/10n
   
Line 120: Line 120:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=158 Problem 158] ==
+
== [http://projecteuler.net/index.php?section=problems&id=158 Problem 158] ==
 
Exploring strings for which only one character comes lexicographically after its neighbour to the left.
 
Exploring strings for which only one character comes lexicographically after its neighbour to the left.
   
Line 128: Line 128:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=159 Problem 159] ==
+
== [http://projecteuler.net/index.php?section=problems&id=159 Problem 159] ==
 
Digital root sums of factorisations.
 
Digital root sums of factorisations.
   
Line 136: Line 136:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=160 Problem 160] ==
+
== [http://projecteuler.net/index.php?section=problems&id=160 Problem 160] ==
 
Factorial trailing digits
 
Factorial trailing digits
   

Revision as of 13:57, 22 January 2008

Contents

1 Problem 151

Paper sheets of standard sizes: an expected-value problem.

Solution:

problem_151 = undefined

2 Problem 152

Writing 1/2 as a sum of inverse squares

Note that if p is an odd prime, the sum of inverse squares of all terms divisible by p must have reduced denominator not divisible by p.

Solution:

import Data.Ratio
import Data.List
 
invSq n = 1 % (n * n)
sumInvSq = sum . map invSq
 
subsets (x:xs) = let s = subsets xs in s ++ map (x :) s
subsets _      = [[]]
 
primes = 2 : 3 : 7 : [p | p <- [11, 13..79],
                          all (\q -> p `mod` q /= 0) [3, 5, 7]]
 
-- All subsets whose sum of inverse squares,
-- when added to x, does not contain a factor of p
pfree s x p = [(y, t) | t <- subsets s, let y =  x + sumInvSq t,
                        denominator y `mod` p /= 0]
 
-- Verify that we need not consider terms divisible by 11, or by any
-- prime greater than 13. Nor need we consider any term divisible
-- by 25, 27, 32, or 49.
verify = all (\p -> null $ tail $ pfree [p, 2*p..85] 0 p) $
         11 : dropWhile (< 17) primes ++ [25, 27, 32, 49]
 
-- All pairs (x, s) where x is a rational number whose reduced
-- denominator is not divisible by any prime greater than 3;
-- and s is all sets of numbers up to 80 divisible
-- by a prime greater than 3, whose sum of inverse squares is x.
only23 = foldl f [(0, [[]])] [13, 7, 5]
  where
    f a p = collect $ [(y, u ++ v) | (x, s) <- a,
                                     (y, v) <- pfree (terms p) x p,
                                     u <- s]
    terms p = [n * p | n <- [1..80`div`p],
                       all (\q -> n `mod` q /= 0) $
                           11 : takeWhile (>= p) [13, 7, 5]
              ]
    collect = map (\z -> (fst $ head z, map snd z)) .
              groupBy fstEq . sortBy cmpFst
    fstEq  (x, _) (y, _) = x == y
    cmpFst (x, _) (y, _) = compare x y
 
-- All subsets (of an ordered set) whose sum of inverse squares is x
findInvSq x y = f x $ zip3 y (map invSq y) (map sumInvSq $ init $ tails y)
  where
    f 0 _        = [[]]
    f x ((n, r, s):ns)
     | r > x     = f x ns
     | s < x     = []
     | otherwise = map (n :) (f (x - r) ns) ++ f x ns
    f _ _        = []
 
-- All numbers up to 80 that are divisible only by the primes
-- 2 and 3 and are not divisible by 32 or 27.
all23 = [n | a <- [0..4], b <- [0..2], let n = 2^a * 3^b, n <= 80]
 
solutions = if verify
              then [sort $ u ++ v | (x, s) <- only23,
                                    u <- findInvSq (1%2 - x) all23,
                                    v <- s]
              else undefined
 
problem_152 = length solutions

3 Problem 153

Investigating Gaussian Integers

Solution:

problem_153 = undefined

4 Problem 154

Exploring Pascal's pyramid.

Solution:

problem_154 = undefined

5 Problem 155

Counting Capacitor Circuits.

Solution:

problem_155 = undefined

6 Problem 156

Counting Digits

Solution:

problem_156 = undefined

7 Problem 157

Solving the diophantine equation 1/a+1/b= p/10n

Solution:

problem_157 = undefined

8 Problem 158

Exploring strings for which only one character comes lexicographically after its neighbour to the left.

Solution:

problem_158 = undefined

9 Problem 159

Digital root sums of factorisations.

Solution:

problem_159 = undefined

10 Problem 160

Factorial trailing digits

We use the following two facts:

Fact 1:
(2^(d + 4*5^(d-1)) - 2^d) `mod` 10^d == 0
Fact 2:
product [n | n <- [0..10^d], gcd n 10 == 1] `mod` 10^d == 1

We really only need these two facts for the special case of

d == 5
, and we can verify that directly by

evaluating the above two Haskell expressions.

More generally:

Fact 1 follows from the fact that the group of invertible elements

of the ring of integers modulo
5^d
has
4*5^(d-1)
elements.

Fact 2 follows from the fact that the group of invertible elements

of the ring of integers modulo
10^d
is isomorphic to the product

of a cyclic group of order 2 and another cyclic group.

Solution:

problem_160 = trailingFactorialDigits 5 (10^12)
 
trailingFactorialDigits d n = twos `times` odds
  where
    base = 10 ^ d
    x `times` y = (x * y) `mod` base
    multiply = foldl' times 1
    x `toPower` k = multiply $ genericReplicate n x
    e = facFactors 2 n - facFactors 5 n
    twos
     | e <= d    = 2 `toPower` e
     | otherwise = 2 `toPower` (d + (e - d) `mod` (4 * 5 ^ (d - 1)))
    odds = multiply [odd | a <- takeWhile (<= n) $ iterate (* 2) 1,
                           b <- takeWhile (<= n) $ iterate (* 5) a,
                           odd <- [3, 5 .. n `div` b `mod` base],
                           odd `mod` 5 /= 0]
 
-- The number of factors of the prime p in n!
facFactors p = sum . zipWith (*) (iterate (\x -> p * x + 1) 1) .
               tail . radix p
 
-- The digits of n in base b representation
radix p = map snd . takeWhile (/= (0, 0)) .
          iterate ((`divMod` p) . fst) . (`divMod` p)

it have another fast way to do this .

Solution:

import Data.List
mulMod :: Integral a => a -> a -> a -> a
mulMod a b c= (b * c) `rem` a
squareMod :: Integral a => a -> a -> a
squareMod a b = (b * b) `rem` a
pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a
pow' _ _ _ 0 = 1
pow' mul sq x' n' = f x' n' 1
    where
    f x n y
        | n == 1 = x `mul` y
        | r == 0 = f x2 q y
        | otherwise = f x2 q (x `mul` y)
        where
            (q,r) = quotRem n 2
            x2 = sq x
powMod :: Integral a => a -> a -> a -> a
powMod m = pow' (mulMod m) (squareMod m)
 
productMod =foldl (mulMod (10^5)) 1
hFacial 0=1
hFacial a
    |gcd a 5==1=mod (a*hFacial(a-1)) (5^5)
    |otherwise=hFacial(a-1)
fastFacial a= hFacial $mod a 6250
numPrime x p=takeWhile(>0) [div x (p^a)|a<-[1..]]
p160 x=mulMod t5 a b
    where
    t5=10^5
    lst=numPrime x 5
    a=powMod t5 1563 $mod c 2500
    b=productMod  c6 
    c=sum lst
    c6=map fastFacial $x:lst
problem_160 = p160 (10^12)