Euler problems/131 to 140
From HaskellWiki
Contents |
1 Problem 131
Determining primes, p, for which n3 + n2p is a perfect cube.
Solution:
primes=sieve [2..] sieve (x:xs)=x:sieve [y|y<-xs,mod y x>0] primeFactors n = factor n primes where factor _ [] = [] factor m (p:ps) | p*p > m = [m] | m `mod` p == 0 = p : factor (m `div` p) (p:ps) | otherwise = factor m ps isPrime n = case (primeFactors n) of (_:_:_) -> False _ -> True problem_131 = length $ takeWhile (<1000000) [x| a<-[1 .. ], let x=(3*a*(a+1)+1), isPrime x]
2 Problem 132
Determining the first forty prime factors of a very large repunit.
Solution:
problem_132 = undefined
3 Problem 133
Investigating which primes will never divide a repunit containing 10n digits.
Solution:
problem_133 = undefined
4 Problem 134
Finding the smallest positive integer related to any pair of consecutive primes.
Solution:
problem_134 = undefined
5 Problem 135
Determining the number of solutions of the equation x2 − y2 − z2 = n.
Solution:
import List primes :: [Integer] primes = 2 : filter ((==1) . length . primeFactors) [3,5..] primeFactors :: Integer -> [Integer] primeFactors n = factor n primes where factor _ [] = [] factor m (p:ps) | p*p > m = [m] | m `mod` p == 0 = p : factor (m `div` p) (p:ps) | otherwise = factor m ps isPrime :: Integer -> Bool isPrime 1 = False isPrime n = case (primeFactors n) of (_:_:_) -> False _ -> True fstfac x = [(head a ,length a)|a<-group$primeFactors x] fac [(x,y)]=[x^a|a<-[0..y]] fac (x:xs)=[a*b|a<-fac [x],b<-fac xs] factors x=fac$fstfac x fastfun x |mod x 4==3=[a|a<-factors x,a*a<3*x] |mod x 16==4=[a|let n=div x 4,a<-factors n,a*a<3*n] |mod x 16==12=[a|let n=div x 4,a<-factors n,a*a<3*n] |mod x 16==0=[a|let n=div x 16,a<-factors n,a*a<3*n] |otherwise=[] slowfun x =[a|a<-factors x,a*a<3*x,let b=div x a,mod (a+b) 4==0] problem_135 =[a|a<-[1..groups],(length$fastfun a)==10]
6 Problem 136
Discover when the equation x2 − y2 − z2 = n has a unique solution.
Solution:
-- fastfun in the problem 135 groups=1000000 pfast=[a|a<-[1..5000],(length$fastfun a)==1] pslow=[a|a<-[1..5000],(length$slowfun a)==1] -- find len pfast=len pslow+2 -- so sum file.log and +2 problem_136 b=[a|a<-[1+b*groups..groups*(b+1)],(length$fastfun a)==1] google num -- write file to change bignum to small num =if (num>49) then return() else do appendFile "file.log" ((show$length$problem_136 num) ++ "\n") google (num+1) main=google 0
7 Problem 137
Determining the value of infinite polynomial series for which the coefficients are Fibonacci numbers.
Solution:
-- afx=x/(1-x-x^2)=n -- ->5*n^2+2*n+1=d^2 -- ->let k=10*n+2 -- ->20*d^2=k^2+16 -- ->5*d^2=k^2+4 -- ->let d k is even -- ->5*d^2=k^2+1 -- ->let d k is odd -- ->5*d^2=k^2+4 import Data.List findmin d = d:head [[n,m]|m<-[1..10],n<-[1..10],n*n==d*m*m+1] findmin_s d = d:head [[n,m]|m<-[1..10],n<-[1..10],n*n==d*m*m-1] findmu d y= d:head [[n,m]|m<-[1..10],n<-[1..10],n*n==d-y*m] mux2 [d,a, b]=[d,a,-b] mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] pow 1 x=x pow n x =mult x $pow (n-1) x where mult [d,a, b] [_,a1, b1]=d:[a*a1+d*b*b1,a*b1+b*a1] fun =[c|a<-[1..20],[_,b,_]<-powmu a,let bb=abs(b),mod bb 5==1,let c=div bb 5] powmu n = [a,b] where c=pow n $findmin 5 x1=findmu 5 4 x2=mux2 x1 a=mult c x1 b=mult c x2 fun2=[c|a<-[1..20],let[_,b,_]=pow a $findmin_s 5,let bb=b*2,mod bb 5==1,let c=div bb 5] problem_137 =(!!14)$sort $(++fun)$fun2
8 Problem 138
Investigating isosceles triangle for which the height and base length differ by one.
Solution:
problem_138 = undefined
9 Problem 139
Finding Pythagorean triangles which allow the square on the hypotenuse square to be tiled.
Solution:
problem_139 = undefined
10 Problem 140
Investigating the value of infinite polynomial series for which the coefficients are a linear second order recurrence relation.
Solution:
problem_140 = undefined
