Euler problems/171 to 180

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.

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

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)

Problem 174

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

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

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]

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

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

Problem 179

Consecutive positive divisors.

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)