Personal tools

Euler problems/171 to 180

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
m (import)
(Unrelated content)
Line 41: Line 41:
 
== [http://projecteuler.net/index.php?section=problems&id=174 Problem 174] ==
 
== [http://projecteuler.net/index.php?section=problems&id=174 Problem 174] ==
 
Counting the number of "hollow" square laminae that can form one, two, three, ... distinct arrangements.
 
Counting the number of "hollow" square laminae that can form one, two, three, ... distinct arrangements.
 
Solution: This was my C++ code, published here without my permission nor any attribution, shame on whoever put it here. [[user:henk263|henk263]]
 
   
 
== [http://projecteuler.net/index.php?section=problems&id=175 Problem 175] ==
 
== [http://projecteuler.net/index.php?section=problems&id=175 Problem 175] ==

Revision as of 08:42, 26 February 2008

Contents

1 Problem 171

Finding numbers for which the sum of the squares of the digits is a square.

Solution: this was Antoine Celeriers C code pasted from the Project Euler Forum.

2 Problem 172

Investigating numbers with few repeated digits.

Solution:

factorial n = product [1..toInteger n]
 
fallingFactorial x n = product [x - fromInteger i | i <- [0..toInteger n - 1] ]
 
choose n k = fallingFactorial n k `div` factorial k
 
-- how many numbers can we get having d digits and p positions
p172 0 _ = 0
p172 d p 
    | p < 4 = d^p
    | otherwise = 
        (p172' p) +  p*(p172' (p-1)) + (choose p 2)*(p172' (p-2)) + (choose p 3)*(p172' (p-3))
    where
    p172' = p172 (d-1)
 
problem_172= (p172 10 18) * 9 `div` 10

3 Problem 173

Using up to one million tiles how many different "hollow" square laminae can be formed? Solution:

problem_173=
    let c=div (10^6) 4
        xm=floor$sqrt $fromIntegral c
        k=[div c x|x<-[1..xm]]
    in  sum k-(div (xm*(xm+1)) 2)

4 Problem 174

Counting the number of "hollow" square laminae that can form one, two, three, ... distinct arrangements.

5 Problem 175

Fractions involving the number of different ways a number can be expressed as a sum of powers of 2. Solution:

sternTree x 0=[]
sternTree x y=
    m:sternTree y n  
    where
    (m,n)=divMod x y
findRat x y
    |odd l=take (l-1) k++[last k-1,1]
    |otherwise=k
    where
    k=sternTree x y
    l=length k
p175 x y= 
    init$foldl (++) "" [a++","|
    a<-map show $reverse $filter (/=0)$findRat x y]
problems_175=p175 123456789 987654321
test=p175 13 17

6 Problem 176

Rectangular triangles that share a cathetus. Solution:

--k=47547 
--2*k+1=95095 = 5*7*11*13*19
lst=[5,7,11,13,19]
primes=[2,3,5,7,11]
problem_176 =
    product[a^b|(a,b)<-zip primes (reverse n)]
    where
    la=div (last lst+1) 2
    m=map (\x->div x 2)$init lst
    n=m++[la]

7 Problem 177

Integer angled Quadrilaterals.

Solution: This C++ solution is stolen from balakrishnan. Check out the forum if you want to see his solution to the problem

8 Problem 178

Step Numbers

Count pandigital step numbers.

import qualified Data.Map as M
 
data StepState a = StepState { minDigit  :: a
                             , maxDigit  :: a
                             , lastDigit :: a
                             } deriving (Show, Eq, Ord)
 
isSolution (StepState i a _) = i == 0 && a == 9
neighborStates m s@(StepState i a n) = map (\x -> (x, M.findWithDefault 0 s m)) $
    [StepState (min i (n - 1)) a (n - 1), StepState i (max a (n + 1)) (n + 1)]
 
allStates    = [StepState i a n | (i, a) <- range ((0, 0), (9, 9)), n <- range (i, a)]
initialState = M.fromDistinctAscList [(StepState i i i, 1) | i <- [1..9]]
stepState m  = M.fromListWith (+) $ allStates >>= neighborStates m
numSolutionsInMap    = sum . map snd . filter (isSolution . fst) . M.toList
numSolutionsOfSize n = sum . map numSolutionsInMap . take n $ iterate stepState initialState
 
problem_178 = numSolutionsOfSize 40

9 Problem 179

Consecutive positive divisors.

10 Problem 180

Rational zeros of a function of three variables. Solution:

import Data.Ratio
 
{-
  After some algebra, we find:
   f1 n x y z = x^(n+1) + y^(n+1) - z^(n+1)
   f2 n x y z = (x*y + y*z + z*x) * ( x^(n-1) + y^(n-1) - z^(n-1) )
   f3 n x y z = x*y*z*( x^(n-2) + y^(n-2) - z^(n-2) )
   f n x y z = f1 n x y z + f2 n x y z - f3 n x y z
   f n x y z = (x+y+z) * (x^n+y^n-z^n)
Now the hard part comes in realizing that n can be negative.  
Thanks to Fermat, we only need examine the cases n = [-2, -1, 1, 2]
Which leads to:
 
f(-2) z = xy/sqrt(x^2 + y^2)
f(-1) z = xy/(x+y)
f(1)  z = x+y
f(2)  z = sqrt(x^2 + y^2)
 
-}
 
unique ::  Eq(a) => [a] -> [a]
unique [] = []
unique (x:xs) | elem x xs = unique xs
              | otherwise = x : unique xs
 
-- Not quite correct, but I don't care about the zeros
ratSqrt :: Rational -> Rational
ratSqrt x = 
  let a = floor $ sqrt $ fromIntegral $ numerator x
      b = floor $ sqrt $ fromIntegral $ denominator x
      c = (a%b) * (a%b)
  in if x == c then (a%b) else 0
 
-- Not quite correct, but I don't care about the zeros
reciprocal :: Rational -> Rational
reciprocal x 
  | x == 0 = 0
  | otherwise = denominator x % numerator x
 
problem_180 =
  let order = 35
      range :: [Rational]            
      range = unique [ (a%b) | b <- [1..order], a <- [1..(b-1)] ]
      fm2,fm1,f1,f2 :: [[Rational]]
      fm2 = [[x,y,z] | x<-range, y<-range, 
            let z = x*y * reciprocal (ratSqrt(x*x+y*y)), elem z range]
      fm1 = [[x,y,z] | x<-range, y<-range, 
            let z = x*y * reciprocal (x+y), elem z range]
      f1  = [[x,y,z] | x<-range, y<-range, 
            let z = (x+y), elem z range]
      f2  = [[x,y,z] | x<-range, y<-range, 
            let z = ratSqrt(x*x+y*y), elem z range]            
      result = sum $ unique $ map (\x -> sum x) (fm2++fm1++f1++f2)
  in (numerator result + denominator result)