https://wiki.haskell.org/api.php?action=feedcontributions&user=Quale&feedformat=atomHaskellWiki - User contributions [en]2024-03-28T22:33:41ZUser contributionsMediaWiki 1.35.5https://wiki.haskell.org/index.php?title=Talk:Euler_problems/1_to_10&diff=19588Talk:Euler problems/1 to 102008-02-26T16:55:00Z<p>Quale: "primes" is in problem 3</p>
<hr />
<div>Should the "solution" of problem 10 not contain a way how the primes are constructed? In itself its no solution.<br />
[[User: hk|hk]]<br />
*It's in problem 3 earlier on the page. The <tt>primes</tt> function is needed for the solution of many problems. [[User:Quale|Quale]] 16:55, 26 February 2008 (UTC)</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/81_to_90&diff=19547Euler problems/81 to 902008-02-25T19:07:58Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=87 Problem 87] */ restore simpler solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=81 Problem 81] ==<br />
Find the minimal path sum from the top left to the bottom right by moving right and down.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (unfoldr)<br />
<br />
columns s = <br />
unfoldr f s<br />
where<br />
f [] = Nothing<br />
f xs = Just $ (\(a,b) -> (read a, drop 1 b)) $ break (==',') xs<br />
<br />
firstLine ls = scanl1 (+) ls<br />
<br />
nextLine pl [] = pl<br />
nextLine pl (n:nl) = <br />
nextLine p' nl<br />
where<br />
p' = nextCell (head pl) pl n<br />
nextCell _ [] [] = []<br />
nextCell pc (p:pl) (n:nl) = <br />
pc' : nextCell pc' pl nl<br />
where pc' = n + min p pc<br />
<br />
minSum (p:nl) = <br />
last $ nextLine p' nl<br />
where<br />
p' = firstLine p<br />
<br />
problem_81 c = minSum $ map columns $ lines c<br />
main=do<br />
f<-readFile "matrix.txt"<br />
print$problem_81 f<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=82 Problem 82] ==<br />
Find the minimal path sum from the left column to the right column.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import qualified Data.Map as M<br />
import Data.Array<br />
<br />
minPathSum xs t= <br />
stepPath M.empty $ M.singleton t $ arr ! t<br />
where <br />
len = genericLength $ head xs<br />
ys = concat $ transpose xs<br />
arr = listArray ((1, 1), (len, len)) ys<br />
nil = ((0,0),0)<br />
stepPath ds as <br />
|fs2 p1==len =snd p1 <br />
|fs2 p2==len =snd p2 <br />
|fs2 p3==len =snd p3 <br />
|otherwise=stepPath ds' as3<br />
where<br />
fs2=fst.fst<br />
((i, j), cost) = <br />
minimumBy (\(_,a) (_,b) -> compare a b) $ M.assocs as<br />
tas = M.delete (i,j) as<br />
(p1, as1) = if i == len then (nil, tas) else check (i+1, j) tas<br />
(p2, as2) = if j == len then (nil, as1) else check (i, j+1) as1<br />
(p3, as3) = if j == 1 then (nil, as2) else check (i, j-1) as2<br />
check pos zs =<br />
if pos `M.member` tas || pos `M.member` ds <br />
then (nil, zs)<br />
else (entry, uncurry M.insert entry $ zs)<br />
where<br />
entry = (pos, cost + arr ! pos) <br />
ds' = M.insert (i, j) cost ds<br />
<br />
main=do<br />
let parse = map (read . ("["++) . (++"]")) . words<br />
a<-readFile "matrix.txt"<br />
let s=parse a<br />
let m=minimum[p|a<-[1..80],let p=minPathSum s (1,a)]<br />
appendFile "p82.log"$show m<br />
<br />
problem_82 = main<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=83 Problem 83] ==<br />
Find the minimal path sum from the top left to the bottom right by moving left, right, up, and down.<br />
<br />
Solution:<br />
<br />
A very verbose solution based on the Dijkstra algorithm. Infinity could be represented by any large value instead of the data type Distance. Also, some equality and ordering tests are not really correct. To be semantically correct, I think infinity == infinity should not be True and infinity > infinity should fail. But for this script's purpose it works like this.<br />
<br />
<haskell><br />
import Array (Array, listArray, bounds, inRange, assocs, (!))<br />
import qualified Data.Map as M <br />
(fromList, Map, foldWithKey, <br />
lookup, null, delete, insert, empty, update)<br />
import Data.List (unfoldr)<br />
import Control.Monad.State (State, execState, get, put)<br />
import Data.Maybe (fromJust, fromMaybe)<br />
<br />
type Weight = Integer<br />
<br />
data Distance = D Weight | Infinity<br />
deriving (Show)<br />
<br />
instance Eq Distance where<br />
(==) Infinity Infinity = True<br />
(==) (D a) (D b) = a == b<br />
(==) _ _ = False<br />
<br />
instance Ord Distance where<br />
compare Infinity Infinity = EQ<br />
compare Infinity (D _) = GT<br />
compare (D _) Infinity = LT<br />
compare (D a) (D b) = compare a b<br />
<br />
data (Eq n, Num w) => Arc n w = A {node :: n, weight :: w}<br />
deriving (Show)<br />
<br />
type Index = (Int, Int)<br />
type NodeMap = M.Map Index Distance<br />
type Matrix = Array Index Weight<br />
type Path = Arc Index Weight<br />
type PathMap = M.Map Index [Path]<br />
<br />
data Queues = Q {input :: NodeMap, output :: NodeMap, pathMap :: PathMap}<br />
deriving (Show)<br />
<br />
listToMatrix :: [[Weight]] -> Matrix<br />
listToMatrix xs = listArray ((1,1),(cols,rows)) $ concat $ xs<br />
where<br />
cols = length $ head xs<br />
rows = length xs<br />
<br />
directions :: [Index]<br />
directions = [(0,-1), (0,1), (-1,0), (1,0)]<br />
<br />
add :: (Num a) => (a, a) -> (a, a) -> (a, a)<br />
add (a,b) (a', b') = (a+a',b+b')<br />
<br />
arcs :: Matrix -> Index -> [Path]<br />
arcs a idx = do<br />
d <- directions<br />
let n = add idx d<br />
if (inRange (bounds a) n) then<br />
return $ A n (a ! n)<br />
else<br />
fail "out of bounds"<br />
<br />
paths :: Matrix -> PathMap<br />
paths a = M.fromList $ map (\(idx,_) -> (idx, arcs a idx)) $ assocs a<br />
<br />
nodes :: Matrix -> NodeMap<br />
nodes a = <br />
M.fromList $ (\((i,_):xs) -> (i, D (a ! (1,1))):xs) $ <br />
map (\(idx,_) -> (idx, Infinity)) $ assocs a<br />
<br />
extractMin :: NodeMap -> (NodeMap, (Index, Distance))<br />
extractMin m = (M.delete (fst minNode) m, minNode)<br />
where<br />
minNode = M.foldWithKey mini ((0,0), Infinity) m<br />
mini i' v' (i,v)<br />
| v' < v = (i', v')<br />
| otherwise = (i,v)<br />
<br />
dijkstra :: State Queues ()<br />
dijkstra = do<br />
Q i o am <- get<br />
let (i', n) = extractMin i<br />
let o' = M.insert (fst n) (snd n) o<br />
let i'' = updateNodes n am i'<br />
put $ Q i'' o' am<br />
if M.null i'' then return () else dijkstra<br />
<br />
updateNodes :: (Index, Distance) -> PathMap -> NodeMap -> NodeMap<br />
updateNodes (i, D d) am nm = foldr f nm ds<br />
where<br />
ds = fromJust $ M.lookup i am<br />
f :: Path -> NodeMap -> NodeMap<br />
f (A i' w) m = fromMaybe m val<br />
where<br />
val = do<br />
v <- M.lookup i' m<br />
if (D $ d+w) < v then<br />
return $ M.update (const $ Just $ D (d+w)) i' m<br />
else return m<br />
<br />
shortestPaths :: Matrix -> NodeMap<br />
shortestPaths xs = output $ dijkstra `execState` (Q n M.empty a)<br />
where<br />
n = nodes xs<br />
a = paths xs<br />
<br />
problem_83 :: [[Weight]] -> Weight<br />
problem_83 xs = jd $ M.lookup idx $ shortestPaths matrix<br />
where<br />
matrix = listToMatrix xs<br />
idx = snd $ bounds matrix<br />
jd (Just (D d)) = d<br />
main=do<br />
f<-readFile "matrix.txt"<br />
let m=map sToInt $lines f<br />
print $problem_83 m<br />
split :: Char -> String -> [String]<br />
split = unfoldr . split'<br />
<br />
split' :: Char -> String -> Maybe (String, String)<br />
split' c l<br />
| null l = Nothing<br />
| otherwise = Just (h, drop 1 t)<br />
where (h, t) = span (/=c) l<br />
sToInt x=map ((+0).read) $split ',' x<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=84 Problem 84] ==<br />
In the game, Monopoly, find the three most popular squares when using two 4-sided dice.<br />
<br />
{{sect-stub}}<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=85 Problem 85] ==<br />
Investigating the number of rectangles in a rectangular grid.<br />
<br />
Solution:<br />
<haskell><br />
import List<br />
problem_85 = snd$head$sort <br />
[(k,a*b)|<br />
a<-[1..100],<br />
b<-[1..100],<br />
let k=abs (a*(a+1)*(b+1)*b-8000000)<br />
]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=86 Problem 86] ==<br />
Exploring the shortest path from one corner of a cuboid to another.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
isSquare x = <br />
(truncate $ sqrt $ fromIntegral x)^2 == x<br />
<br />
cube m = <br />
sum [ (a`div`2) - if a > m then (a - m -1) else 0|<br />
a <- [1..2*m],<br />
isSquare ((a)^2 + m2)<br />
]<br />
where<br />
m2 = m * m<br />
<br />
problem_86 =<br />
findIndex (>1000000) (scanl (+) 0 (map cube [1..]))<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=87 Problem 87] ==<br />
Investigating numbers that can be expressed as the sum of a prime square, cube, and fourth power?<br />
<br />
Solution:<br />
<haskell><br />
import List<br />
<br />
problem_87 = length expressible<br />
where limit = 50000000<br />
squares = takeWhile (<limit) (map (^2) primes)<br />
cubes = takeWhile (<limit) (map (^3) primes)<br />
fourths = takeWhile (<limit) (map (^4) primes)<br />
choices = [[s,c,f] | s <- squares, c <- cubes, f <- fourths]<br />
unique = map head . group . sort<br />
expressible = filter (<limit) . unique . map sum $ choices<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=88 Problem 88] ==<br />
Exploring minimal product-sum numbers for sets of different sizes.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import qualified Data.Set as S<br />
import qualified Data.Map as M<br />
<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..] <br />
primeFactors n = factors n primes<br />
where factors n (p:ps) | p*p > n = [n]<br />
| n `mod` p == 0 = p : factors (n `div` p) (p:ps)<br />
| otherwise = factors n ps<br />
isPrime n | n > 1 = (==1) . length . primeFactors $ n<br />
| otherwise = False<br />
<br />
facts = concat . takeWhile valid . iterate facts' . (:[])<br />
where valid xs = length (head xs) > 1<br />
facts' = nub' . concatMap factsnext<br />
nub' = S.toList . S.fromList<br />
factsnext xs = <br />
let factsnext' [] = []<br />
factsnext' (y:ys) = map (form y) ys ++ factsnext' ys<br />
form a b = a*b : (delete b . delete a $ xs)<br />
in map sort . factsnext' $ xs <br />
<br />
problem_88 = sum' . extract . scanl addks M.empty . filter (not . isPrime) $ [2..]<br />
where extract = head . dropWhile (\nm -> M.size nm < 11999)<br />
sum' = S.fold (+) 0 . S.fromList . M.elems<br />
addks nm n = foldl (addk n) nm . facts . primeFactors $ n<br />
addk n nm ps =<br />
let k = length ps + n - sum ps<br />
kGood = k > 1 && k < 12001 && k `M.notMember` nm<br />
in if kGood then M.insert k n nm else nm<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=89 Problem 89] ==<br />
Develop a method to express Roman numerals in minimal form.<br />
<br />
Solution:<br />
<haskell><br />
replace ([], _) zs = zs<br />
replace _ [] = []<br />
replace (xs, ys) zzs@(z:zs)<br />
| xs == lns = ys ++ rns<br />
| otherwise = z : replace (xs, ys) zs<br />
where<br />
(lns, rns) = splitAt (length xs) zzs<br />
<br />
problem_89 = <br />
print . difference . words =<< readFile "roman.txt"<br />
where<br />
difference xs = sum (map length xs) - sum (map (length . reduce) xs)<br />
reduce xs = foldl (flip replace) xs [("DCCCC","CM"), ("CCCC","CD"), <br />
("LXXXX","XC"), ("XXXX","XL"), <br />
("VIIII","IX"), ("IIII","IV")]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=90 Problem 90] ==<br />
An unexpected way of using two cubes to make a square.<br />
<br />
Solution:<br />
<br />
Basic brute force: generate all possible die combinations and check each one to see if we can make all the necessary squares. Runs very fast even for brute force.<br />
<br />
<haskell><br />
-- all lists consisting of n elements from the given list<br />
choose 0 _ = [[]]<br />
choose _ [] = []<br />
choose n (x:xs) =<br />
( map ( x : ) ( choose ( n - 1 ) xs ) ) ++ ( choose n xs )<br />
<br />
-- cross product helper function<br />
cross f xs ys = [ f x y | x <- xs, y <- ys ]<br />
<br />
-- all dice combinations<br />
-- substitute 'k' for both '6' and '9' to make comparisons easier<br />
dice = cross (,) ( choose 6 "012345k78k" ) ( choose 6 "012345k78k" )<br />
<br />
-- can we make all square numbers from the two dice<br />
-- again, substitute 'k' for '6' and '9'<br />
makeSquares dice =<br />
all ( makeSquare dice ) [ "01", "04", "0k", "1k", "25", "3k", "4k", "k4", "81" ]<br />
<br />
-- can we make this square from the two dice<br />
makeSquare ( xs, ys ) [ d1, d2 ] =<br />
( ( ( d1 `elem` xs ) && ( d2 `elem` ys ) ) || ( ( d2 `elem` xs ) && ( d1 `elem` ys ) ) )<br />
<br />
problem_90 =<br />
( `div` 2 ) . -- because each die combinations will appear twice<br />
length .<br />
filter makeSquares<br />
$ dice<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=User_talk:Henrylaxen&diff=19546User talk:Henrylaxen2008-02-25T17:47:01Z<p>Quale: many Euler problems have better solutions on the page history</p>
<hr />
<div>==[[Euler problems]]==<br />
Hi Henry. Some of the problem solutions you are wondering about were actually better before [[User:Lisp]] "optimized" them. Look at the page history to check to see what it looked like before his helpful contributions. I'm trying to reverse some of the damage now. [[User:Quale|Quale]] 17:47, 25 February 2008 (UTC)</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19545Euler problems/31 to 402008-02-25T17:45:01Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] */ fix oops in last edit</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, (\\))<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
permutations :: Integer -> [Integer]<br />
permutations n = take l $ map (read . take l) $ tails $ take (2*l -1) $ cycle s<br />
where<br />
s = show n<br />
l = length s<br />
<br />
circular_primes :: [Integer] -> [Integer]<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where<br />
p = permutations x<br />
<br />
problem_35 :: Int<br />
problem_35 = length $ circular_primes $ takeWhile (<1000000) primes<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
import Numeric<br />
import Data.Char<br />
<br />
showBin = flip (showIntAtBase 2 intToDigit) ""<br />
<br />
isPalindrome x = x == reverse x<br />
<br />
problem_36 = sum [x | x <- [1,3..1000000], isPalindrome (show x), isPalindrome (showBin x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, inits, nub)<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
truncs :: Integer -> [Integer]<br />
truncs n = nub . map read $ (take l . tail . tails) s ++ (take l . tail . inits) s<br />
where<br />
l = length s - 1<br />
s = show n<br />
<br />
problem_37 = sum $ take 11 [x | x <- dropWhile (<=9) primes, all isPrime (truncs x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..floor (sqrt 1000)],<br />
m <- [n+1..floor (sqrt 1000)],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = (d 1)*(d 10)*(d 100)*(d 1000)*(d 10000)*(d 100000)*(d 1000000)<br />
where n = concat [show n | n <- [1..]]<br />
d j = Data.Char.digitToInt (n !! (j-1))<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19544Euler problems/31 to 402008-02-25T17:44:41Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] */ restore another solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, (\\))<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
permutations :: Integer -> [Integer]<br />
permutations n = take l $ map (read . take l) $ tails $ take (2*l -1) $ cycle s<br />
where<br />
s = show n<br />
l = length s<br />
<br />
circular_primes :: [Integer] -> [Integer]<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where<br />
p = permutations x<br />
<br />
problem_35 :: Int<br />
problem_35 = length $ circular_primes $ takeWhile (<1000000) primes<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
import Numeric<br />
import Data.Char<br />
<br />
showBin = flip (showIntAtBase 2 intToDigit) ""<br />
<br />
isPalindrome x = x == reverse x<br />
<br />
problem_36 = sum [x | x <- [1,3..1000000], isPalindrome (show x), isPalindrome (showBin x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, inits, nub)<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
truncs :: Integer -> [Integer]<br />
truncs n = nub . map read $ (take l . tail . tails) s ++ (take l . tail . inits) s<br />
where<br />
l = length s - 1<br />
s = show n<br />
<br />
problem_37 = sum $ take 11 [x | x <- dropWhile (<=9) primes, all isPrime (truncs x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..floor (sqrt 1000)],<br />
m <- [n+1..floor (sqrt 1000)],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
<haskell><br />
problem_40 = (d 1)*(d 10)*(d 100)*(d 1000)*(d 10000)*(d 100000)*(d 1000000)<br />
where n = concat [show n | n <- [1..]]<br />
d j = Data.Char.digitToInt (n !! (j-1))<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19543Euler problems/31 to 402008-02-25T17:43:59Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] */ restore another solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, (\\))<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
permutations :: Integer -> [Integer]<br />
permutations n = take l $ map (read . take l) $ tails $ take (2*l -1) $ cycle s<br />
where<br />
s = show n<br />
l = length s<br />
<br />
circular_primes :: [Integer] -> [Integer]<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where<br />
p = permutations x<br />
<br />
problem_35 :: Int<br />
problem_35 = length $ circular_primes $ takeWhile (<1000000) primes<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
import Numeric<br />
import Data.Char<br />
<br />
showBin = flip (showIntAtBase 2 intToDigit) ""<br />
<br />
isPalindrome x = x == reverse x<br />
<br />
problem_36 = sum [x | x <- [1,3..1000000], isPalindrome (show x), isPalindrome (showBin x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, inits, nub)<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
truncs :: Integer -> [Integer]<br />
truncs n = nub . map read $ (take l . tail . tails) s ++ (take l . tail . inits) s<br />
where<br />
l = length s - 1<br />
s = show n<br />
<br />
problem_37 = sum $ take 11 [x | x <- dropWhile (<=9) primes, all isPrime (truncs x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..floor (sqrt 1000)],<br />
m <- [n+1..floor (sqrt 1000)],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A023103<br />
problem_40 = product [1, 1, 5, 3, 7, 2, 1]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19542Euler problems/31 to 402008-02-25T17:41:59Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] */ restore yet another solution erased by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, (\\))<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
permutations :: Integer -> [Integer]<br />
permutations n = take l $ map (read . take l) $ tails $ take (2*l -1) $ cycle s<br />
where<br />
s = show n<br />
l = length s<br />
<br />
circular_primes :: [Integer] -> [Integer]<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where<br />
p = permutations x<br />
<br />
problem_35 :: Int<br />
problem_35 = length $ circular_primes $ takeWhile (<1000000) primes<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
import Numeric<br />
import Data.Char<br />
<br />
showBin = flip (showIntAtBase 2 intToDigit) ""<br />
<br />
isPalindrome x = x == reverse x<br />
<br />
problem_36 = sum [x | x <- [1,3..1000000], isPalindrome (show x), isPalindrome (showBin x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, inits, nub)<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
truncs :: Integer -> [Integer]<br />
truncs n = nub . map read $ (take l . tail . tails) s ++ (take l . tail . inits) s<br />
where<br />
l = length s - 1<br />
s = show n<br />
<br />
problem_37 = sum $ take 11 [x | x <- dropWhile (<=9) primes, all isPrime (truncs x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A046079<br />
problem_39 = let t = 3*5*7<br />
in floor(2^floor(log(1000/t)/log 2)*t)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A023103<br />
problem_40 = product [1, 1, 5, 3, 7, 2, 1]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19541Euler problems/31 to 402008-02-25T17:41:10Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] */ restore yet another solution removed by User:Lisp, sigh</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, (\\))<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
permutations :: Integer -> [Integer]<br />
permutations n = take l $ map (read . take l) $ tails $ take (2*l -1) $ cycle s<br />
where<br />
s = show n<br />
l = length s<br />
<br />
circular_primes :: [Integer] -> [Integer]<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where<br />
p = permutations x<br />
<br />
problem_35 :: Int<br />
problem_35 = length $ circular_primes $ takeWhile (<1000000) primes<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
import Numeric<br />
import Data.Char<br />
<br />
showBin = flip (showIntAtBase 2 intToDigit) ""<br />
<br />
isPalindrome x = x == reverse x<br />
<br />
problem_36 = sum [x | x <- [1,3..1000000], isPalindrome (show x), isPalindrome (showBin x)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
-- isPrime in p35<br />
-- http://www.research.att.com/~njas/sequences/A020994<br />
problem_37 = sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A046079<br />
problem_39 = let t = 3*5*7<br />
in floor(2^floor(log(1000/t)/log 2)*t)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A023103<br />
problem_40 = product [1, 1, 5, 3, 7, 2, 1]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19540Euler problems/31 to 402008-02-25T17:40:22Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] */ rm premature "optimization"</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List (tails, (\\))<br />
<br />
primes :: [Integer]<br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
<br />
primeFactors :: Integer -> [Integer]<br />
primeFactors n = factor n primes<br />
where<br />
factor _ [] = []<br />
factor m (p:ps) | p*p > m = [m]<br />
| m `mod` p == 0 = p : factor (m `div` p) (p:ps)<br />
| otherwise = factor m ps<br />
<br />
isPrime :: Integer -> Bool<br />
isPrime 1 = False<br />
isPrime n = case (primeFactors n) of<br />
(_:_:_) -> False<br />
_ -> True<br />
<br />
permutations :: Integer -> [Integer]<br />
permutations n = take l $ map (read . take l) $ tails $ take (2*l -1) $ cycle s<br />
where<br />
s = show n<br />
l = length s<br />
<br />
circular_primes :: [Integer] -> [Integer]<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where<br />
p = permutations x<br />
<br />
problem_35 :: Int<br />
problem_35 = length $ circular_primes $ takeWhile (<1000000) primes<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A007632<br />
problem_36 = sum [0, 1, 3, 5, 7, 9, 33, 99, 313, 585, 717,<br />
7447, 9009, 15351, 32223, 39993, 53235,<br />
53835, 73737, 585585]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
-- isPrime in p35<br />
-- http://www.research.att.com/~njas/sequences/A020994<br />
problem_37 = sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A046079<br />
problem_39 = let t = 3*5*7<br />
in floor(2^floor(log(1000/t)/log 2)*t)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A023103<br />
problem_40 = product [1, 1, 5, 3, 7, 2, 1]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=19539Euler problems/31 to 402008-02-25T17:37:14Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] */ restore erased solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of [[memoization]], dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = ways [1,2,5,10,20,50,100,200] !!200<br />
where ways [] = 1 : repeat 0<br />
ways (coin:coins) =n <br />
where n = zipWith (+) (ways coins) (take coin (repeat 0) ++ n)<br />
</haskell><br />
<br />
A beautiful solution, making usage of laziness and recursion to implement a dynamic programming scheme, blazingly fast despite actually generating the combinations and not only counting them :<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
combinations = foldl (\without p -><br />
let (poor,rich) = splitAt p without<br />
with = poor ++ zipWith (++) (map (map (p:)) with)<br />
rich<br />
in with<br />
) ([[]] : repeat [])<br />
<br />
problem_31 = length $ combinations coins !! 200<br />
</haskell><br />
<br />
The above may be ''a beautiful solution'', but I couldn't understand it without major mental gymnastics. I would like to offer the following, which I hope will be easier to follow for ordinary ''mentats'' -- HenryLaxen 2008-02-22<br />
<haskell><br />
coins = [1,2,5,10,20,50,100,200]<br />
<br />
withcoins 1 x = [[x]]<br />
withcoins n x = concatMap addCoin [0 .. x `div` coins!!(n-1)]<br />
where addCoin k = map (++[k]) (withcoins (n-1) (x - k*coins!!(n-1)) )<br />
<br />
problem_31 = length $ withcoins (length coins) 200 <br />
</haskell><br />
<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
<br />
combs 0 xs = [([],xs)]<br />
combs n xs = [(y:ys,rest) | y <- xs, (ys,rest) <- combs (n-1) (delete y xs)]<br />
<br />
l2n :: (Integral a) => [a] -> a<br />
l2n = foldl' (\a b -> 10*a+b) 0<br />
<br />
swap (a,b) = (b,a)<br />
<br />
explode :: (Integral a) => a -> [a]<br />
explode = unfoldr (\a -> if a==0 then Nothing else Just . swap $ quotRem a 10)<br />
<br />
pandigiticals =<br />
nub $ do (beg,end) <- combs 5 [1..9]<br />
n <- [1,2]<br />
let (a,b) = splitAt n beg<br />
res = l2n a * l2n b<br />
guard $ sort (explode res) == end<br />
return res<br />
<br />
problem_32 = sum pandigiticals<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator . product $ rs<br />
{-<br />
xy/yz = x/z<br />
(10x + y)/(10y+z) = x/z<br />
9xz + yz = 10xy<br />
-}<br />
rs = [(10*x+y)%(10*y+z) | x <- t, <br />
y <- t, <br />
z <- t,<br />
x /= y ,<br />
(9*x*z) + (y*z) == (10*x*y)]<br />
where t = [1..9]<br />
</haskell><br />
<br />
That is okay, but why not let the computer do the ''thinking'' for you? Isn't this a little more directly expressive of the problem? -- HenryLaxen 2008-02-34<br />
<haskell><br />
import Data.Ratio<br />
problem_33 = denominator $ product <br />
[ a%c | a<-[1..9], b<-[1..9], c<-[1..9],<br />
isCurious a b c, a /= b && a/= c]<br />
where isCurious a b c = ((10*a+b)%(10*b+c)) == (a%c)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_34 = sum [ x | x <- [3..100000], x == facsum x ]<br />
where facsum = sum . map (product . enumFromTo 1 . digitToInt) . show<br />
<br />
</haskell><br />
<br />
Another way:<br />
<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
{-<br />
<br />
The key comes in realizing that N*9! < 10^N when N >= 9, so we<br />
only have to check up to 9 digit integers. The other key is<br />
that addition is commutative, so we only need to generate<br />
combinations (with duplicates) of the sums of the various<br />
factorials. These sums are the only potential "curious" sums.<br />
<br />
-}<br />
<br />
fac n = a!n<br />
where a = listArray (0,9) (1:(scanl1 (*) [1..9]))<br />
<br />
-- subsets of size k, including duplicates<br />
combinationsOf 0 _ = [[]]<br />
combinationsOf _ [] = []<br />
combinationsOf k (x:xs) = map (x:) <br />
(combinationsOf (k-1) (x:xs)) ++ combinationsOf k xs<br />
<br />
intToList n = reverse $ unfoldr <br />
(\x -> if x == 0 then Nothing else Just (x `mod` 10, x `div` 10)) n<br />
<br />
isCurious (n,l) = sort (intToList n) == l<br />
<br />
-- Turn a list into the sum of the factorials of the digits<br />
factorialSum l = foldr (\x y -> (fac x) + y) 0 l<br />
<br />
possiblyCurious = map (\z -> (factorialSum z,z)) <br />
curious n = filter isCurious $ possiblyCurious $ combinationsOf n [0..9]<br />
problem_34 = sum $ (fst . unzip) $ concatMap curious [2..9]<br />
</haskell><br />
(The wiki formatting is messing up the unzip"&gt;unzip line above, it is correct in the version I typed in. It should of course just be fst . unzip)<br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
millerRabinPrimality on the [[Prime_numbers]] page<br />
<br />
<i>Note: Miller Rabin for primes less than 1000000?<br />
Why not use a primesieve?</i><br />
<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A068652<br />
isPrime x<br />
| x==1 = False<br />
| x==2 = True<br />
| x==3 = True<br />
| otherwise = millerRabinPrimality x 2<br />
<br />
permutations n = take l<br />
. map (read . take l)<br />
. tails<br />
. take (2*l-1)<br />
. cycle $ s<br />
where s = show n<br />
l = length s<br />
<br />
circular_primes [] = []<br />
circular_primes (x:xs)<br />
| all isPrime p = x : circular_primes xs<br />
| otherwise = circular_primes xs<br />
where p = permutations x<br />
<br />
x = [1,3,7,9] <br />
<br />
dmm = foldl (\x y->x*10+y) 0<br />
<br />
xx n = map dmm (replicateM n x)<br />
<br />
problem_35 = (+13) . length . circular_primes <br />
$ [a | a <- concat [xx 3,xx 4,xx 5,xx 6], isPrime a]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A007632<br />
problem_36 = sum [0, 1, 3, 5, 7, 9, 33, 99, 313, 585, 717,<br />
7447, 9009, 15351, 32223, 39993, 53235,<br />
53835, 73737, 585585]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
-- isPrime in p35<br />
-- http://www.research.att.com/~njas/sequences/A020994<br />
problem_37 = sum [23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
<br />
mult n i vs <br />
| length (concat vs) >= 9 = concat vs<br />
| otherwise = mult n (i+1) (vs ++ [show (n * i)])<br />
<br />
problem_38 = maximum . map read . filter ((['1'..'9'] ==) .sort) <br />
$ [mult n 1 [] | n <- [2..9999]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A046079<br />
problem_39 = let t = 3*5*7<br />
in floor(2^floor(log(1000/t)/log 2)*t)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A023103<br />
problem_40 = product [1, 1, 5, 3, 7, 2, 1]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=User_talk:Lisp&diff=19538User talk:Lisp2008-02-25T17:25:51Z<p>Quale: stop damaging Euler problems</p>
<hr />
<div>==[[Euler problems/11 to 20]]==<br />
Do you think it's better to replace the simple generation of triangle numbers with a hard coded list? I think it was better before with<br />
:triangleNumbers = scanl1 (+) [1..]<br />
There's no performance advantage to the hard coded list, and it limits the problem size to just the numbers you included. How do you know how many you need before hand? [[User:Quale|Quale]] 17:52, 18 February 2008 (UTC)<br />
<br />
==[[Euler problems]]==<br />
Please don't remove valid solutions to the problems, and certainly don't replace them with references to the OEIS. [[User:Quale|Quale]] 17:25, 25 February 2008 (UTC)</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=19537Euler problems/21 to 302008-02-25T17:23:12Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] */ restore solution to problem erased by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
(http://www.research.att.com/~njas/sequences/A063990)<br />
<br />
This is a little slow because of the naive method used to compute the divisors.<br />
<haskell><br />
problem_21 = sum [m+n | m <- [2..9999], let n = divisorsSum ! m, amicable m n]<br />
where amicable m n = m < n && n < 10000 && divisorsSum ! n == m<br />
divisorsSum = array (1,9999)<br />
[(i, sum (divisors i)) | i <- [1..9999]]<br />
divisors n = [j | j <- [1..n `div` 2], n `mod` j == 0]<br />
</haskell><br />
<br />
Here is an alternative using a faster way of computing the sum of divisors.<br />
<haskell><br />
problem_21_v2 = sum [n | n <- [2..9999], let m = d n,<br />
m > 1, m < 10000, n == d m]<br />
d n = product [(p * product g - 1) `div` (p - 1) |<br />
g <- group $ primeFactors n, let p = head g<br />
] - n<br />
primeFactors = pf primes<br />
where<br />
pf ps@(p:ps') n<br />
| p * p > n = [n]<br />
| r == 0 = p : pf ps q<br />
| otherwise = pf ps' n<br />
where (q, r) = n `divMod` p<br />
primes = 2 : filter (null . tail . primeFactors) [3,5..]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import Data.Char<br />
problem_22 =<br />
do input <- readFile "names.txt"<br />
let names = sort $ read$"["++ input++"]"<br />
let scores = zipWith score names [1..]<br />
print . show . sum $ scores<br />
where score w i = (i *) . sum . map (\c -> ord c - ord 'A' + 1) $ w<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A048242<br />
import Data.Array <br />
n = 28124<br />
abundant n = eulerTotient n - n > n<br />
abunds_array = listArray (1,n) $ map abundant [1..n]<br />
abunds = filter (abunds_array !) [1..n]<br />
<br />
rests x = map (x-) $ takeWhile (<= x `div` 2) abunds<br />
isSum = any (abunds_array !) . rests<br />
<br />
problem_23 = putStrLn . show . foldl1 (+) . filter (not . isSum) $ [1..n] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List <br />
<br />
fac 0 = 1<br />
fac n = n * fac (n - 1)<br />
perms [] _= []<br />
perms xs n= x : perms (delete x xs) (mod n m)<br />
where m = fac $ length xs - 1<br />
y = div n m<br />
x = xs!!y<br />
<br />
problem_24 = perms "0123456789" 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = fst $ maximumBy (\a b -> snd a `compare` snd b)<br />
[(n,recurringCycle n) | n <- [1..999]]<br />
where recurringCycle d = remainders d 10 []<br />
remainders d 0 rs = 0<br />
remainders d r rs = let r' = r `mod` d<br />
in case findIndex (== r') rs of<br />
Just i -> i + 1<br />
Nothing -> remainders d (10*r') (r':rs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = -(2*a-1)*(a^2-a+41)<br />
where n = 1000<br />
m = head $ filter (\x->x^2-x+41>n) [1..]<br />
a = m-1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = sum (map (\n -> 4*(n-2)^2+10*(n-1)) [3,5..1001]) + 1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
problem_29 = length . group . sort $ liftM2 (^) [2..100] [2..100] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char (ord)<br />
<br />
limit :: Integer<br />
limit = snd $ head $ dropWhile (\(a,b) -> a > b) $ zip (map (9^5*) [1..]) (map (10^) [1..])<br />
<br />
fifth :: Integer -> Integer<br />
fifth n = foldr (\a b -> (toInteger(ord a) - 48)^5 + b) 0 $ show n<br />
<br />
problem_30 :: Integer<br />
problem_30 = sum $ filter (\n -> n == fifth n) [2..limit]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=19536Euler problems/21 to 302008-02-25T17:13:04Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] */ restore a correct solution that was replaced by a wrong one</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
(http://www.research.att.com/~njas/sequences/A063990)<br />
<br />
This is a little slow because of the naive method used to compute the divisors.<br />
<haskell><br />
problem_21 = sum [m+n | m <- [2..9999], let n = divisorsSum ! m, amicable m n]<br />
where amicable m n = m < n && n < 10000 && divisorsSum ! n == m<br />
divisorsSum = array (1,9999)<br />
[(i, sum (divisors i)) | i <- [1..9999]]<br />
divisors n = [j | j <- [1..n `div` 2], n `mod` j == 0]<br />
</haskell><br />
<br />
Here is an alternative using a faster way of computing the sum of divisors.<br />
<haskell><br />
problem_21_v2 = sum [n | n <- [2..9999], let m = d n,<br />
m > 1, m < 10000, n == d m]<br />
d n = product [(p * product g - 1) `div` (p - 1) |<br />
g <- group $ primeFactors n, let p = head g<br />
] - n<br />
primeFactors = pf primes<br />
where<br />
pf ps@(p:ps') n<br />
| p * p > n = [n]<br />
| r == 0 = p : pf ps q<br />
| otherwise = pf ps' n<br />
where (q, r) = n `divMod` p<br />
primes = 2 : filter (null . tail . primeFactors) [3,5..]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import Data.Char<br />
problem_22 =<br />
do input <- readFile "names.txt"<br />
let names = sort $ read$"["++ input++"]"<br />
let scores = zipWith score names [1..]<br />
print . show . sum $ scores<br />
where score w i = (i *) . sum . map (\c -> ord c - ord 'A' + 1) $ w<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A048242<br />
import Data.Array <br />
n = 28124<br />
abundant n = eulerTotient n - n > n<br />
abunds_array = listArray (1,n) $ map abundant [1..n]<br />
abunds = filter (abunds_array !) [1..n]<br />
<br />
rests x = map (x-) $ takeWhile (<= x `div` 2) abunds<br />
isSum = any (abunds_array !) . rests<br />
<br />
problem_23 = putStrLn . show . foldl1 (+) . filter (not . isSum) $ [1..n] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List <br />
<br />
fac 0 = 1<br />
fac n = n * fac (n - 1)<br />
perms [] _= []<br />
perms xs n= x : perms (delete x xs) (mod n m)<br />
where m = fac $ length xs - 1<br />
y = div n m<br />
x = xs!!y<br />
<br />
problem_24 = perms "0123456789" 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = fst $ maximumBy (\a b -> snd a `compare` snd b)<br />
[(n,recurringCycle n) | n <- [1..999]]<br />
where recurringCycle d = remainders d 10 []<br />
remainders d 0 rs = 0<br />
remainders d r rs = let r' = r `mod` d<br />
in case findIndex (== r') rs of<br />
Just i -> i + 1<br />
Nothing -> remainders d (10*r') (r':rs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = -(2*a-1)*(a^2-a+41)<br />
where n = 1000<br />
m = head $ filter (\x->x^2-x+41>n) [1..]<br />
a = m-1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = sum (map (\n -> 4*(n-2)^2+10*(n-1)) [3,5..1001]) + 1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
problem_29 = length . group . sort $ liftM2 (^) [2..100] [2..100] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A052464<br />
problem_30 = sum [4150, 4151, 54748, 92727, 93084, 194979]<br />
</haskell><br />
<br />
I'm sorry, but I find the solution to problem 30 very unsatisfying. I'm using the Euler problems to learn Haskell, so looking up the answer and adding the terms isn't really that helpful. I would like to present the following as a clearer solution that perhaps gives a little more insight into the problem and programming in Haskell. -- Henry Laxen, Feb 20, 2008<br />
<br />
<br />
<haskell><br />
problem_30 = sum $ map listToInt (drop 2 ans)<br />
-- we drop 2 because the first two members of the ans are 0 and 1, <br />
-- which are considered "trivial" solutions and should not count in the sum<br />
where maxFirstDigit = (6*9^5 `div` 10^5) + 1<br />
-- The largest number that can be the sum of fifth powers<br />
-- is 6*9^5 = 354294, which has 6 digits<br />
listToInt n = foldl (\x y -> 10*x+y) 0 n<br />
isSumOfPowers p n = (sum $ map (\x -> x^p) n) == listToInt n<br />
ans = filter (isSumOfPowers 5) [ [a,b,c,d,e,f] | <br />
a <- [0..maxFirstDigit],<br />
b <- [0..9],<br />
c <- [0..9],<br />
d <- [0..9],<br />
e <- [0..9],<br />
f <- [0..9] ]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=19535Euler problems/21 to 302008-02-25T17:09:44Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] */ restore solutions deleted by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
(http://www.research.att.com/~njas/sequences/A063990)<br />
<br />
This is a little slow because of the naive method used to compute the divisors.<br />
<haskell><br />
problem_21 = sum [m+n | m <- [2..9999], let n = divisorsSum ! m, amicable m n]<br />
where amicable m n = m < n && n < 10000 && divisorsSum ! n == m<br />
divisorsSum = array (1,9999)<br />
[(i, sum (divisors i)) | i <- [1..9999]]<br />
divisors n = [j | j <- [1..n `div` 2], n `mod` j == 0]<br />
</haskell><br />
<br />
Here is an alternative using a faster way of computing the sum of divisors.<br />
<haskell><br />
problem_21_v2 = sum [n | n <- [2..9999], let m = d n,<br />
m > 1, m < 10000, n == d m]<br />
d n = product [(p * product g - 1) `div` (p - 1) |<br />
g <- group $ primeFactors n, let p = head g<br />
] - n<br />
primeFactors = pf primes<br />
where<br />
pf ps@(p:ps') n<br />
| p * p > n = [n]<br />
| r == 0 = p : pf ps q<br />
| otherwise = pf ps' n<br />
where (q, r) = n `divMod` p<br />
primes = 2 : filter (null . tail . primeFactors) [3,5..]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import Data.Char<br />
problem_22 =<br />
do input <- readFile "names.txt"<br />
let names = sort $ read$"["++ input++"]"<br />
let scores = zipWith score names [1..]<br />
print . show . sum $ scores<br />
where score w i = (i *) . sum . map (\c -> ord c - ord 'A' + 1) $ w<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A048242<br />
import Data.Array <br />
n = 28124<br />
abundant n = eulerTotient n - n > n<br />
abunds_array = listArray (1,n) $ map abundant [1..n]<br />
abunds = filter (abunds_array !) [1..n]<br />
<br />
rests x = map (x-) $ takeWhile (<= x `div` 2) abunds<br />
isSum = any (abunds_array !) . rests<br />
<br />
problem_23 = putStrLn . show . foldl1 (+) . filter (not . isSum) $ [1..n] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List <br />
<br />
fac 0 = 1<br />
fac n = n * fac (n - 1)<br />
perms [] _= []<br />
perms xs n= x : perms (delete x xs) (mod n m)<br />
where m = fac $ length xs - 1<br />
y = div n m<br />
x = xs!!y<br />
<br />
problem_24 = perms "0123456789" 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = head [a | a<-[999,997..], and [isPrime a, isPrime $ a `div` 2]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = -(2*a-1)*(a^2-a+41)<br />
where n = 1000<br />
m = head $ filter (\x->x^2-x+41>n) [1..]<br />
a = m-1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = sum (map (\n -> 4*(n-2)^2+10*(n-1)) [3,5..1001]) + 1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
problem_29 = length . group . sort $ liftM2 (^) [2..100] [2..100] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A052464<br />
problem_30 = sum [4150, 4151, 54748, 92727, 93084, 194979]<br />
</haskell><br />
<br />
I'm sorry, but I find the solution to problem 30 very unsatisfying. I'm using the Euler problems to learn Haskell, so looking up the answer and adding the terms isn't really that helpful. I would like to present the following as a clearer solution that perhaps gives a little more insight into the problem and programming in Haskell. -- Henry Laxen, Feb 20, 2008<br />
<br />
<br />
<haskell><br />
problem_30 = sum $ map listToInt (drop 2 ans)<br />
-- we drop 2 because the first two members of the ans are 0 and 1, <br />
-- which are considered "trivial" solutions and should not count in the sum<br />
where maxFirstDigit = (6*9^5 `div` 10^5) + 1<br />
-- The largest number that can be the sum of fifth powers<br />
-- is 6*9^5 = 354294, which has 6 digits<br />
listToInt n = foldl (\x y -> 10*x+y) 0 n<br />
isSumOfPowers p n = (sum $ map (\x -> x^p) n) == listToInt n<br />
ans = filter (isSumOfPowers 5) [ [a,b,c,d,e,f] | <br />
a <- [0..maxFirstDigit],<br />
b <- [0..9],<br />
c <- [0..9],<br />
d <- [0..9],<br />
e <- [0..9],<br />
f <- [0..9] ]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=19534Euler problems/11 to 202008-02-25T17:02:00Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] */ fix parts of solution replaced by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=problems&id=11 20 by 20 grid]?<br />
<br />
Solution:<br />
using Array and Arrows, for fun :<br />
<haskell><br />
import Control.Arrow<br />
import Data.Array<br />
<br />
input :: String -> Array (Int,Int) Int<br />
input = listArray ((1,1),(20,20)) . map read . words<br />
<br />
senses = [(+1) *** id,(+1) *** (+1), id *** (+1), (+1) *** (\n -> n - 1)]<br />
<br />
inArray a i = inRange (bounds a) i<br />
<br />
prods :: Array (Int, Int) Int -> [Int]<br />
prods a = [product xs | i <- range $ bounds a,<br />
s <- senses,<br />
let is = take 4 $ iterate s i,<br />
all (inArray a) is,<br />
let xs = map (a!) is]<br />
main = print . maximum . prods . input =<< getContents<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
--primeFactors in problem_3<br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) <br />
triangleNumbers = scanl1 (+) [1..]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
<br />
main = do xs <- fmap (map read . lines) (readFile "p13.log")<br />
print . take 10 . show . sum $ xs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
<haskell> <br />
import Data.List <br />
<br />
problem_14 = j 1000000 where <br />
f :: Int -> Integer -> Int <br />
f k 1 = k <br />
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1 <br />
g x y = if snd x < snd y then y else x <br />
h x n = g x (n, f 1 n) <br />
j n = fst $ foldl' h (1,1) [2..n-1] <br />
</haskell><br />
<br />
Faster solution, using an Array to memoize length of sequences :<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
syrs n = <br />
a<br />
where <br />
a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]<br />
syr n x = <br />
if x' <= n then a ! x' else 1 + syr n x'<br />
where <br />
x' = if even x then x `div` 2 else 3 * x + 1<br />
<br />
main = <br />
print $ foldl' maxBySnd (0,0) $ assocs $ syrs 1000000<br />
where<br />
maxBySnd x@(_,a) y@(_,b) = if a > b then x else y<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
A direct computation:<br />
<haskell> <br />
problem_15 = iterate (scanl1 (+)) (repeat 1) !! 20 !! 20 <br />
</haskell> <br />
<br />
Thinking about it as a problem in combinatorics:<br />
<br />
Each route has exactly 40 steps, with 20 of them horizontal and 20 of<br />
them vertical. We need to count how many different ways there are of<br />
choosing which steps are horizontal and which are vertical. So we have:<br />
<br />
<haskell><br />
problem_15 = product [21..40] `div` product [2..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_16 = sum k<br />
where s = show (2^1000)<br />
k = map digitToInt s<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
import Char<br />
<br />
one = ["one","two","three","four","five","six","seven","eight",<br />
"nine","ten","eleven","twelve","thirteen","fourteen","fifteen",<br />
"sixteen","seventeen","eighteen", "nineteen"]<br />
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]<br />
<br />
decompose x <br />
| x == 0 = []<br />
| x < 20 = one !! (x-1)<br />
| x >= 20 && x < 100 = <br />
ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)<br />
| x < 1000 && x `mod` 100 ==0 = <br />
one !! (firstDigit (x)-1) ++ "hundred"<br />
| x > 100 && x <= 999 = <br />
one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)<br />
| x == 1000 = "onethousand"<br />
<br />
where firstDigit x = digitToInt . head . show $ x<br />
<br />
problem_17 = length . concatMap decompose $ [1..1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = head $ foldr1 g tri <br />
where<br />
f x y z = x + max y z<br />
g xs ys = zipWith3 f xs ys $ tail ys<br />
tri = [<br />
[75],<br />
[95,64],<br />
[17,47,82],<br />
[18,35,87,10],<br />
[20,04,82,47,65],<br />
[19,01,23,75,03,34],<br />
[88,02,77,73,07,63,67],<br />
[99,65,04,28,06,16,70,92],<br />
[41,41,26,56,83,40,80,70,33],<br />
[41,48,72,33,47,32,37,16,94,29],<br />
[53,71,44,65,25,43,91,52,97,51,14],<br />
[70,11,33,28,77,73,17,78,39,68,17,57],<br />
[91,71,52,38,17,14,91,43,58,50,27,29,48],<br />
[63,66,04,68,89,53,67,30,73,16,69,87,40,31],<br />
[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==<br />
You are given the following information, but you may prefer to do some research for yourself.<br />
* 1 Jan 1900 was a Monday.<br />
* Thirty days has September,<br />
* April, June and November.<br />
* All the rest have thirty-one,<br />
* Saving February alone,<br />
Which has twenty-eight, rain or shine.<br />
And on leap years, twenty-nine.<br />
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.<br />
<br />
How many Sundays fell on the first of the month during the twentieth century<br />
(1 Jan 1901 to 31 Dec 2000)?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900<br />
since1900 = scanl nextMonth monday . concat $<br />
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)<br />
<br />
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]<br />
<br />
leap = 31 : 29 : drop 2 nonLeap<br />
<br />
nextMonth x y = (x + y) `mod` 7<br />
<br />
sunday = 0<br />
monday = 1<br />
</haskell><br />
<br />
Here is an alternative that is simpler, but it is cheating a bit:<br />
<br />
<haskell><br />
import Data.Time.Calendar<br />
import Data.Time.Calendar.WeekDate<br />
<br />
problem_19_v2 = length [() | y <- [1901..2000], <br />
m <- [1..12],<br />
let (_, _, d) = toWeekDate $ fromGregorian y m 1,<br />
d == 7]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=19533Euler problems/11 to 202008-02-25T17:00:24Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] */ restore another interesting solution erased by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=problems&id=11 20 by 20 grid]?<br />
<br />
Solution:<br />
using Array and Arrows, for fun :<br />
<haskell><br />
import Control.Arrow<br />
import Data.Array<br />
<br />
input :: String -> Array (Int,Int) Int<br />
input = listArray ((1,1),(20,20)) . map read . words<br />
<br />
senses = [(+1) *** id,(+1) *** (+1), id *** (+1), (+1) *** (\n -> n - 1)]<br />
<br />
inArray a i = inRange (bounds a) i<br />
<br />
prods :: Array (Int, Int) Int -> [Int]<br />
prods a = [product xs | i <- range $ bounds a,<br />
s <- senses,<br />
let is = take 4 $ iterate s i,<br />
all (inArray a) is,<br />
let xs = map (a!) is]<br />
main = print . maximum . prods . input =<< getContents<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A084260<br />
triangleNumbers =<br />
[630, 5460, 25200, 73920, 97020, 157080,<br />
1185030, 2031120, 2162160, 17907120,<br />
76576500, 236215980,7534947420]<br />
--primeFactors in problem_3<br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
<br />
main = do xs <- fmap (map read . lines) (readFile "p13.log")<br />
print . take 10 . show . sum $ xs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
<haskell> <br />
import Data.List <br />
<br />
problem_14 = j 1000000 where <br />
f :: Int -> Integer -> Int <br />
f k 1 = k <br />
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1 <br />
g x y = if snd x < snd y then y else x <br />
h x n = g x (n, f 1 n) <br />
j n = fst $ foldl' h (1,1) [2..n-1] <br />
</haskell><br />
<br />
Faster solution, using an Array to memoize length of sequences :<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
syrs n = <br />
a<br />
where <br />
a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]<br />
syr n x = <br />
if x' <= n then a ! x' else 1 + syr n x'<br />
where <br />
x' = if even x then x `div` 2 else 3 * x + 1<br />
<br />
main = <br />
print $ foldl' maxBySnd (0,0) $ assocs $ syrs 1000000<br />
where<br />
maxBySnd x@(_,a) y@(_,b) = if a > b then x else y<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
A direct computation:<br />
<haskell> <br />
problem_15 = iterate (scanl1 (+)) (repeat 1) !! 20 !! 20 <br />
</haskell> <br />
<br />
Thinking about it as a problem in combinatorics:<br />
<br />
Each route has exactly 40 steps, with 20 of them horizontal and 20 of<br />
them vertical. We need to count how many different ways there are of<br />
choosing which steps are horizontal and which are vertical. So we have:<br />
<br />
<haskell><br />
problem_15 = product [21..40] `div` product [2..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_16 = sum k<br />
where s = show (2^1000)<br />
k = map digitToInt s<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
import Char<br />
<br />
one = ["one","two","three","four","five","six","seven","eight",<br />
"nine","ten","eleven","twelve","thirteen","fourteen","fifteen",<br />
"sixteen","seventeen","eighteen", "nineteen"]<br />
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]<br />
<br />
decompose x <br />
| x == 0 = []<br />
| x < 20 = one !! (x-1)<br />
| x >= 20 && x < 100 = <br />
ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)<br />
| x < 1000 && x `mod` 100 ==0 = <br />
one !! (firstDigit (x)-1) ++ "hundred"<br />
| x > 100 && x <= 999 = <br />
one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)<br />
| x == 1000 = "onethousand"<br />
<br />
where firstDigit x = digitToInt . head . show $ x<br />
<br />
problem_17 = length . concatMap decompose $ [1..1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = head $ foldr1 g tri <br />
where<br />
f x y z = x + max y z<br />
g xs ys = zipWith3 f xs ys $ tail ys<br />
tri = [<br />
[75],<br />
[95,64],<br />
[17,47,82],<br />
[18,35,87,10],<br />
[20,04,82,47,65],<br />
[19,01,23,75,03,34],<br />
[88,02,77,73,07,63,67],<br />
[99,65,04,28,06,16,70,92],<br />
[41,41,26,56,83,40,80,70,33],<br />
[41,48,72,33,47,32,37,16,94,29],<br />
[53,71,44,65,25,43,91,52,97,51,14],<br />
[70,11,33,28,77,73,17,78,39,68,17,57],<br />
[91,71,52,38,17,14,91,43,58,50,27,29,48],<br />
[63,66,04,68,89,53,67,30,73,16,69,87,40,31],<br />
[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==<br />
You are given the following information, but you may prefer to do some research for yourself.<br />
* 1 Jan 1900 was a Monday.<br />
* Thirty days has September,<br />
* April, June and November.<br />
* All the rest have thirty-one,<br />
* Saving February alone,<br />
Which has twenty-eight, rain or shine.<br />
And on leap years, twenty-nine.<br />
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.<br />
<br />
How many Sundays fell on the first of the month during the twentieth century<br />
(1 Jan 1901 to 31 Dec 2000)?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900<br />
since1900 = scanl nextMonth monday . concat $<br />
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)<br />
<br />
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]<br />
<br />
leap = 31 : 29 : drop 2 nonLeap<br />
<br />
nextMonth x y = (x + y) `mod` 7<br />
<br />
sunday = 0<br />
monday = 1<br />
</haskell><br />
<br />
Here is an alternative that is simpler, but it is cheating a bit:<br />
<br />
<haskell><br />
import Data.Time.Calendar<br />
import Data.Time.Calendar.WeekDate<br />
<br />
problem_19_v2 = length [() | y <- [1901..2000], <br />
m <- [1..12],<br />
let (_, _, d) = toWeekDate $ fromGregorian y m 1,<br />
d == 7]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=19532Euler problems/11 to 202008-02-25T16:57:07Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] */ restore another instructive solution erased by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=problems&id=11 20 by 20 grid]?<br />
<br />
Solution:<br />
using Array and Arrows, for fun :<br />
<haskell><br />
import Control.Arrow<br />
import Data.Array<br />
<br />
input :: String -> Array (Int,Int) Int<br />
input = listArray ((1,1),(20,20)) . map read . words<br />
<br />
senses = [(+1) *** id,(+1) *** (+1), id *** (+1), (+1) *** (\n -> n - 1)]<br />
<br />
inArray a i = inRange (bounds a) i<br />
<br />
prods :: Array (Int, Int) Int -> [Int]<br />
prods a = [product xs | i <- range $ bounds a,<br />
s <- senses,<br />
let is = take 4 $ iterate s i,<br />
all (inArray a) is,<br />
let xs = map (a!) is]<br />
main = print . maximum . prods . input =<< getContents<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A084260<br />
triangleNumbers =<br />
[630, 5460, 25200, 73920, 97020, 157080,<br />
1185030, 2031120, 2162160, 17907120,<br />
76576500, 236215980,7534947420]<br />
--primeFactors in problem_3<br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
<br />
main = do xs <- fmap (map read . lines) (readFile "p13.log")<br />
print . take 10 . show . sum $ xs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
<haskell> <br />
import Data.List <br />
<br />
problem_14 = j 1000000 where <br />
f :: Int -> Integer -> Int <br />
f k 1 = k <br />
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1 <br />
g x y = if snd x < snd y then y else x <br />
h x n = g x (n, f 1 n) <br />
j n = fst $ foldl' h (1,1) [2..n-1] <br />
</haskell><br />
<br />
Faster solution, using an Array to memoize length of sequences :<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
syrs n = <br />
a<br />
where <br />
a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]<br />
syr n x = <br />
if x' <= n then a ! x' else 1 + syr n x'<br />
where <br />
x' = if even x then x `div` 2 else 3 * x + 1<br />
<br />
main = <br />
print $ foldl' maxBySnd (0,0) $ assocs $ syrs 1000000<br />
where<br />
maxBySnd x@(_,a) y@(_,b) = if a > b then x else y<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
Here is a bit of explanation, and a few more solutions:<br />
<br />
Each route has exactly 40 steps, with 20 of them horizontal and 20 of<br />
them vertical. We need to count how many different ways there are of<br />
choosing which steps are horizontal and which are vertical. So we have:<br />
<br />
<haskell><br />
problem_15 = product [21..40] `div` product [2..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_16 = sum k<br />
where s = show (2^1000)<br />
k = map digitToInt s<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
import Char<br />
<br />
one = ["one","two","three","four","five","six","seven","eight",<br />
"nine","ten","eleven","twelve","thirteen","fourteen","fifteen",<br />
"sixteen","seventeen","eighteen", "nineteen"]<br />
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]<br />
<br />
decompose x <br />
| x == 0 = []<br />
| x < 20 = one !! (x-1)<br />
| x >= 20 && x < 100 = <br />
ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)<br />
| x < 1000 && x `mod` 100 ==0 = <br />
one !! (firstDigit (x)-1) ++ "hundred"<br />
| x > 100 && x <= 999 = <br />
one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)<br />
| x == 1000 = "onethousand"<br />
<br />
where firstDigit x = digitToInt . head . show $ x<br />
<br />
problem_17 = length . concatMap decompose $ [1..1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = head $ foldr1 g tri <br />
where<br />
f x y z = x + max y z<br />
g xs ys = zipWith3 f xs ys $ tail ys<br />
tri = [<br />
[75],<br />
[95,64],<br />
[17,47,82],<br />
[18,35,87,10],<br />
[20,04,82,47,65],<br />
[19,01,23,75,03,34],<br />
[88,02,77,73,07,63,67],<br />
[99,65,04,28,06,16,70,92],<br />
[41,41,26,56,83,40,80,70,33],<br />
[41,48,72,33,47,32,37,16,94,29],<br />
[53,71,44,65,25,43,91,52,97,51,14],<br />
[70,11,33,28,77,73,17,78,39,68,17,57],<br />
[91,71,52,38,17,14,91,43,58,50,27,29,48],<br />
[63,66,04,68,89,53,67,30,73,16,69,87,40,31],<br />
[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==<br />
You are given the following information, but you may prefer to do some research for yourself.<br />
* 1 Jan 1900 was a Monday.<br />
* Thirty days has September,<br />
* April, June and November.<br />
* All the rest have thirty-one,<br />
* Saving February alone,<br />
Which has twenty-eight, rain or shine.<br />
And on leap years, twenty-nine.<br />
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.<br />
<br />
How many Sundays fell on the first of the month during the twentieth century<br />
(1 Jan 1901 to 31 Dec 2000)?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900<br />
since1900 = scanl nextMonth monday . concat $<br />
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)<br />
<br />
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]<br />
<br />
leap = 31 : 29 : drop 2 nonLeap<br />
<br />
nextMonth x y = (x + y) `mod` 7<br />
<br />
sunday = 0<br />
monday = 1<br />
</haskell><br />
<br />
Here is an alternative that is simpler, but it is cheating a bit:<br />
<br />
<haskell><br />
import Data.Time.Calendar<br />
import Data.Time.Calendar.WeekDate<br />
<br />
problem_19_v2 = length [() | y <- [1901..2000], <br />
m <- [1..12],<br />
let (_, _, d) = toWeekDate $ fromGregorian y m 1,<br />
d == 7]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=19531Euler problems/11 to 202008-02-25T16:50:22Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] */ restore solution erased by User:Lisp</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=problems&id=11 20 by 20 grid]?<br />
<br />
Solution:<br />
using Array and Arrows, for fun :<br />
<haskell><br />
import Control.Arrow<br />
import Data.Array<br />
<br />
input :: String -> Array (Int,Int) Int<br />
input = listArray ((1,1),(20,20)) . map read . words<br />
<br />
senses = [(+1) *** id,(+1) *** (+1), id *** (+1), (+1) *** (\n -> n - 1)]<br />
<br />
inArray a i = inRange (bounds a) i<br />
<br />
prods :: Array (Int, Int) Int -> [Int]<br />
prods a = [product xs | i <- range $ bounds a,<br />
s <- senses,<br />
let is = take 4 $ iterate s i,<br />
all (inArray a) is,<br />
let xs = map (a!) is]<br />
main = print . maximum . prods . input =<< getContents<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A084260<br />
triangleNumbers =<br />
[630, 5460, 25200, 73920, 97020, 157080,<br />
1185030, 2031120, 2162160, 17907120,<br />
76576500, 236215980,7534947420]<br />
--primeFactors in problem_3<br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
<br />
main = do xs <- fmap (map read . lines) (readFile "p13.log")<br />
print . take 10 . show . sum $ xs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
Faster solution, using an Array to memoize length of sequences :<br />
<haskell><br />
import Data.Array<br />
import Data.List<br />
<br />
syrs n = <br />
a<br />
where <br />
a = listArray (1,n) $ 0:[1 + syr n x | x <- [2..n]]<br />
syr n x = <br />
if x' <= n then a ! x' else 1 + syr n x'<br />
where <br />
x' = if even x then x `div` 2 else 3 * x + 1<br />
<br />
main = <br />
print $ foldl' maxBySnd (0,0) $ assocs $ syrs 1000000<br />
where<br />
maxBySnd x@(_,a) y@(_,b) = if a > b then x else y<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
Here is a bit of explanation, and a few more solutions:<br />
<br />
Each route has exactly 40 steps, with 20 of them horizontal and 20 of<br />
them vertical. We need to count how many different ways there are of<br />
choosing which steps are horizontal and which are vertical. So we have:<br />
<br />
<haskell><br />
problem_15 = product [21..40] `div` product [2..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_16 = sum k<br />
where s = show (2^1000)<br />
k = map digitToInt s<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
import Char<br />
<br />
one = ["one","two","three","four","five","six","seven","eight",<br />
"nine","ten","eleven","twelve","thirteen","fourteen","fifteen",<br />
"sixteen","seventeen","eighteen", "nineteen"]<br />
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]<br />
<br />
decompose x <br />
| x == 0 = []<br />
| x < 20 = one !! (x-1)<br />
| x >= 20 && x < 100 = <br />
ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)<br />
| x < 1000 && x `mod` 100 ==0 = <br />
one !! (firstDigit (x)-1) ++ "hundred"<br />
| x > 100 && x <= 999 = <br />
one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)<br />
| x == 1000 = "onethousand"<br />
<br />
where firstDigit x = digitToInt . head . show $ x<br />
<br />
problem_17 = length . concatMap decompose $ [1..1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = head $ foldr1 g tri <br />
where<br />
f x y z = x + max y z<br />
g xs ys = zipWith3 f xs ys $ tail ys<br />
tri = [<br />
[75],<br />
[95,64],<br />
[17,47,82],<br />
[18,35,87,10],<br />
[20,04,82,47,65],<br />
[19,01,23,75,03,34],<br />
[88,02,77,73,07,63,67],<br />
[99,65,04,28,06,16,70,92],<br />
[41,41,26,56,83,40,80,70,33],<br />
[41,48,72,33,47,32,37,16,94,29],<br />
[53,71,44,65,25,43,91,52,97,51,14],<br />
[70,11,33,28,77,73,17,78,39,68,17,57],<br />
[91,71,52,38,17,14,91,43,58,50,27,29,48],<br />
[63,66,04,68,89,53,67,30,73,16,69,87,40,31],<br />
[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==<br />
You are given the following information, but you may prefer to do some research for yourself.<br />
* 1 Jan 1900 was a Monday.<br />
* Thirty days has September,<br />
* April, June and November.<br />
* All the rest have thirty-one,<br />
* Saving February alone,<br />
Which has twenty-eight, rain or shine.<br />
And on leap years, twenty-nine.<br />
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.<br />
<br />
How many Sundays fell on the first of the month during the twentieth century<br />
(1 Jan 1901 to 31 Dec 2000)?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900<br />
since1900 = scanl nextMonth monday . concat $<br />
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)<br />
<br />
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]<br />
<br />
leap = 31 : 29 : drop 2 nonLeap<br />
<br />
nextMonth x y = (x + y) `mod` 7<br />
<br />
sunday = 0<br />
monday = 1<br />
</haskell><br />
<br />
Here is an alternative that is simpler, but it is cheating a bit:<br />
<br />
<haskell><br />
import Data.Time.Calendar<br />
import Data.Time.Calendar.WeekDate<br />
<br />
problem_19_v2 = length [() | y <- [1901..2000], <br />
m <- [1..12],<br />
let (_, _, d) = toWeekDate $ fromGregorian y m 1,<br />
d == 7]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=19230Euler problems/21 to 302008-02-20T19:05:32Z<p>Quale: /* Problem 25 */ restore old solution to problem 25 to avoid gratuitous complexity</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A063990<br />
problem_21 = sum [220, 284, 1184, 1210, 2620, 2924, 5020, 5564, 6232, 6368]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import Data.Char<br />
problem_22 =<br />
do input <- readFile "names.txt"<br />
let names = sort $ read$"["++ input++"]"<br />
let scores = zipWith score names [1..]<br />
print . show . sum $ scores<br />
where score w i = (i *) . sum . map (\c -> ord c - ord 'A' + 1) $ w<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A048242<br />
import Data.Array <br />
n = 28124<br />
abundant n = eulerTotient n - n > n<br />
abunds_array = listArray (1,n) $ map abundant [1..n]<br />
abunds = filter (abunds_array !) [1..n]<br />
<br />
rests x = map (x-) $ takeWhile (<= x `div` 2) abunds<br />
isSum = any (abunds_array !) . rests<br />
<br />
problem_23 = putStrLn . show . foldl1 (+) . filter (not . isSum) $ [1..n] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List <br />
<br />
fac 0 = 1<br />
fac n = n * fac (n - 1)<br />
perms [] _= []<br />
perms xs n= x : perms (delete x xs) (mod n m)<br />
where m = fac $ length xs - 1<br />
y = div n m<br />
x = xs!!y<br />
<br />
problem_24 = perms "0123456789" 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = head [a | a<-[999,997..], and [isPrime a, isPrime $ a `div` 2]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = -(2*a-1)*(a^2-a+41)<br />
where n = 1000<br />
m = head $ filter (\x->x^2-x+41>n) [1..]<br />
a = m-1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = sum (map (\n -> 4*(n-2)^2+10*(n-1)) [3,5..1001]) + 1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
problem_29 = length . group . sort $ liftM2 (^) [2..100] [2..100] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A052464<br />
problem_30 = sum [4150, 4151, 54748, 92727, 93084, 194979]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=19229Euler problems/11 to 202008-02-20T17:24:01Z<p>Quale: /* Problem 20 */ simplify solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=problems&id=11 20 by 20 grid]?<br />
<br />
Solution:<br />
using Array and Arrows, for fun :<br />
<haskell><br />
import Control.Arrow<br />
import Data.Array<br />
<br />
input :: String -> Array (Int,Int) Int<br />
input = listArray ((1,1),(20,20)) . map read . words<br />
<br />
senses = [(+1) *** id,(+1) *** (+1), id *** (+1), (+1) *** (\n -> n - 1)]<br />
<br />
inArray a i = inRange (bounds a) i<br />
<br />
prods :: Array (Int, Int) Int -> [Int]<br />
prods a = [product xs | i <- range $ bounds a,<br />
s <- senses,<br />
let is = take 4 $ iterate s i,<br />
all (inArray a) is,<br />
let xs = map (a!) is]<br />
main = print . maximum . prods . input =<< getContents<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A084260<br />
triangleNumbers =<br />
[630, 5460, 25200, 73920, 97020, 157080,<br />
1185030, 2031120, 2162160, 17907120,<br />
76576500, 236215980,7534947420]<br />
--primeFactors in problem_3<br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where nDivisors n = product $ map ((+1) . length) (group (primeFactors n)) <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
<br />
main = do xs <- fmap (map read . lines) (readFile "p13.log")<br />
print . take 10 . show . sum $ xs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
Faster solution, using an Array to memoize length of sequences :<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A033958<br />
problem_14=837799<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
Here is a bit of explanation, and a few more solutions:<br />
<br />
Each route has exactly 40 steps, with 20 of them horizontal and 20 of<br />
them vertical. We need to count how many different ways there are of<br />
choosing which steps are horizontal and which are vertical. So we have:<br />
<br />
<haskell><br />
problem_15 = product [21..40] `div` product [2..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char<br />
problem_16 = sum k<br />
where s = show (2^1000)<br />
k = map digitToInt s<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
import Char<br />
<br />
one = ["one","two","three","four","five","six","seven","eight",<br />
"nine","ten","eleven","twelve","thirteen","fourteen","fifteen",<br />
"sixteen","seventeen","eighteen", "nineteen"]<br />
ty = ["twenty","thirty","forty","fifty","sixty","seventy","eighty","ninety"]<br />
<br />
decompose x <br />
| x == 0 = []<br />
| x < 20 = one !! (x-1)<br />
| x >= 20 && x < 100 = <br />
ty !! (firstDigit (x) - 2) ++ decompose ( x - firstDigit (x) * 10)<br />
| x < 1000 && x `mod` 100 ==0 = <br />
one !! (firstDigit (x)-1) ++ "hundred"<br />
| x > 100 && x <= 999 = <br />
one !! (firstDigit (x)-1) ++ "hundredand" ++decompose ( x - firstDigit (x) * 100)<br />
| x == 1000 = "onethousand"<br />
<br />
where firstDigit x = digitToInt . head . show $ x<br />
<br />
problem_17 = length . concatMap decompose $ [1..1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = head $ foldr1 g tri <br />
where<br />
f x y z = x + max y z<br />
g xs ys = zipWith3 f xs ys $ tail ys<br />
tri = [<br />
[75],<br />
[95,64],<br />
[17,47,82],<br />
[18,35,87,10],<br />
[20,04,82,47,65],<br />
[19,01,23,75,03,34],<br />
[88,02,77,73,07,63,67],<br />
[99,65,04,28,06,16,70,92],<br />
[41,41,26,56,83,40,80,70,33],<br />
[41,48,72,33,47,32,37,16,94,29],<br />
[53,71,44,65,25,43,91,52,97,51,14],<br />
[70,11,33,28,77,73,17,78,39,68,17,57],<br />
[91,71,52,38,17,14,91,43,58,50,27,29,48],<br />
[63,66,04,68,89,53,67,30,73,16,69,87,40,31],<br />
[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==<br />
You are given the following information, but you may prefer to do some research for yourself.<br />
* 1 Jan 1900 was a Monday.<br />
* Thirty days has September,<br />
* April, June and November.<br />
* All the rest have thirty-one,<br />
* Saving February alone,<br />
Which has twenty-eight, rain or shine.<br />
And on leap years, twenty-nine.<br />
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.<br />
<br />
How many Sundays fell on the first of the month during the twentieth century<br />
(1 Jan 1901 to 31 Dec 2000)?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = length . filter (== sunday) . drop 12 . take 1212 $ since1900<br />
since1900 = scanl nextMonth monday . concat $<br />
replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)<br />
<br />
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]<br />
<br />
leap = 31 : 29 : drop 2 nonLeap<br />
<br />
nextMonth x y = (x + y) `mod` 7<br />
<br />
sunday = 0<br />
monday = 1<br />
</haskell><br />
<br />
Here is an alternative that is simpler, but it is cheating a bit:<br />
<br />
<haskell><br />
import Data.Time.Calendar<br />
import Data.Time.Calendar.WeekDate<br />
<br />
problem_19_v2 = length [() | y <- [1901..2000], <br />
m <- [1..12],<br />
let (_, _, d) = toWeekDate $ fromGregorian y m 1,<br />
d == 7]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = sum $ map Char.digitToInt $ show $ product [1..100]<br />
</haskell></div>Qualehttps://wiki.haskell.org/index.php?title=User_talk:Lisp&diff=19202User talk:Lisp2008-02-18T17:52:11Z<p>Quale: I think it's better to not hard code the triangle numbers</p>
<hr />
<div>==[[Euler problems/11 to 20]]==<br />
Do you think it's better to replace the simple generation of triangle numbers with a hard coded list? I think it was better before with<br />
:triangleNumbers = scanl1 (+) [1..]<br />
There's no performance advantage to the hard coded list, and it limits the problem size to just the numbers you included. How do you know how many you need before hand? [[User:Quale|Quale]] 17:52, 18 February 2008 (UTC)</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/41_to_50&diff=12492Euler problems/41 to 502007-04-11T01:25:12Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==<br />
What is the largest n-digit pandigital prime that exists?<br />
<br />
Solution:<br />
<haskell><br />
problem_41 = head [p | n <- init (tails "987654321"),<br />
p <- perms n, isPrime (read p)]<br />
where perms [] = [[]]<br />
perms xs = [x:ps | x <- xs, ps <- perms (delete x xs)]<br />
isPrime n = n > 1 && smallestDivisor n == n<br />
smallestDivisor n = findDivisor n (2:[3,5..])<br />
findDivisor n (testDivisor:rest)<br />
| n `mod` testDivisor == 0 = testDivisor<br />
| testDivisor*testDivisor >= n = n<br />
| otherwise = findDivisor n rest<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=42 Problem 42] ==<br />
How many triangle words can you make using the list of common English words?<br />
<br />
Solution:<br />
<haskell><br />
problem_42 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=43 Problem 43] ==<br />
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.<br />
<br />
Solution:<br />
<haskell><br />
problem_43 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=44 Problem 44] ==<br />
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.<br />
<br />
Solution:<br />
<haskell><br />
problem_44 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] ==<br />
After 40755, what is the next triangle number that is also pentagonal and hexagonal?<br />
<br />
Solution:<br />
<haskell><br />
problem_45 = head . dropWhile (<= 40755) $ match tries (match pents hexes)<br />
where match (x:xs) (y:ys)<br />
| x < y = match xs (y:ys)<br />
| y < x = match (x:xs) ys<br />
| otherwise = x : match xs ys<br />
tries = [n*(n+1) `div` 2 | n <- [1..]]<br />
pents = [n*(3*n-1) `div` 2 | n <- [1..]]<br />
hexes = [n*(2*n-1) | n <- [1..]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] ==<br />
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?<br />
<br />
Solution:<br />
<br />
This solution is inspired by exercise 3.70 in ''Structure and Interpretation of Computer Programs'', (2nd ed.).<br />
<br />
<haskell><br />
problem_46 = head $ oddComposites `orderedDiff` gbSums<br />
<br />
oddComposites = filter ((>1) . length . primeFactors) [3,5..]<br />
<br />
gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n | n <- [1..]]<br />
gbWeight (a,b) = a + b<br />
<br />
weightedPairs w (x:xs) (y:ys) =<br />
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))<br />
<br />
mergeWeighted w (x:xs) (y:ys)<br />
| w x <= w y = x : mergeWeighted w xs (y:ys)<br />
| otherwise = y : mergeWeighted w (x:xs) ys<br />
<br />
x `orderedDiff` [] = x<br />
[] `orderedDiff` y = []<br />
(x:xs) `orderedDiff` (y:ys)<br />
| x < y = x : xs `orderedDiff` (y:ys)<br />
| x > y = (x:xs) `orderedDiff` ys<br />
| otherwise = xs `orderedDiff` ys<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=47 Problem 47] ==<br />
Find the first four consecutive integers to have four distinct primes factors.<br />
<br />
Solution:<br />
<haskell><br />
problem_47 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] ==<br />
Find the last ten digits of 1<sup>1</sup> + 2<sup>2</sup> + ... + 1000<sup>1000</sup>.<br />
<br />
Solution:<br />
If the problem were more computationally intensive, [http://en.wikipedia.org/wiki/Modular_exponentiation modular exponentiation] might be appropriate. With this problem size the naive approach is sufficient.<br />
<haskell><br />
problem_48 = sum [n^n | n <- [1..1000]] `mod` 10^10<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=49 Problem 49] ==<br />
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.<br />
<br />
Solution:<br />
<haskell><br />
problem_49 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=50 Problem 50] ==<br />
Which prime, below one-million, can be written as the sum of the most consecutive primes?<br />
<br />
Solution:<br />
<haskell><br />
problem_50 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=12490Euler problems/31 to 402007-04-11T00:48:32Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of memoization, dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = pence 200 [1,2,5,10,20,50,100,200]<br />
where pence 0 _ = 1<br />
pence n [] = 0<br />
pence n denominations@(d:ds)<br />
| n < d = 0<br />
| otherwise = pence (n - d) denominations<br />
+ pence n ds<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
problem_32 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
problem_33 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_34 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
problem_35 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
problem_36 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
problem_37 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
problem_38 = maximum $ catMaybes [result | j <- [1..9999],<br />
let p2 = show j ++ show (2*j),<br />
let p3 = p2 ++ show (3*j),<br />
let p4 = p3 ++ show (4*j),<br />
let p5 = p4 ++ show (5*j),<br />
let result<br />
| isPan p2 = Just p2<br />
| isPan p3 = Just p3<br />
| isPan p4 = Just p4<br />
| isPan p5 = Just p5<br />
| otherwise = Nothing]<br />
where isPan s = sort s == "123456789"<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..floor (sqrt 1000)],<br />
m <- [n+1..floor (sqrt 1000)],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = (d 1)*(d 10)*(d 100)*(d 1000)*(d 10000)*(d 100000)*(d 1000000)<br />
where n = concat [show n | n <- [1..]]<br />
d j = Data.Char.digitToInt (n !! (j-1))<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=12489Euler problems/31 to 402007-04-11T00:24:03Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] */ a solution (cleanup welcome)</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of memoization, dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = pence 200 [1,2,5,10,20,50,100,200]<br />
where pence 0 _ = 1<br />
pence n [] = 0<br />
pence n denominations@(d:ds)<br />
| n < d = 0<br />
| otherwise = pence (n - d) denominations<br />
+ pence n ds<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
problem_32 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
problem_33 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_34 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
problem_35 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
problem_36 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
problem_37 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
problem_38 = maximum $ catMaybes [result | j <- [1..9999],<br />
let p2 = show j ++ show (2*j),<br />
let p3 = p2 ++ show (3*j),<br />
let p4 = p3 ++ show (4*j),<br />
let p5 = p4 ++ show (5*j),<br />
let result<br />
| isPan p2 = Just p2<br />
| isPan p3 = Just p3<br />
| isPan p4 = Just p4<br />
| isPan p5 = Just p5<br />
| otherwise = Nothing]<br />
where isPan s = sort s == "123456789"<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..floor (sqrt 1000)],<br />
m <- [n+1..floor (sqrt 1000)],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/51_to_60&diff=12488Euler problems/51 to 602007-04-10T19:13:51Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=52 Problem 52] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=51 Problem 51] ==<br />
Find the smallest prime which, by changing the same part of the number, can form eight different primes.<br />
<br />
Solution:<br />
<haskell><br />
problem_51 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=52 Problem 52] ==<br />
Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x, contain the same digits in some order.<br />
<br />
Solution:<br />
<haskell><br />
problem_52 = head [n | n <- [1..],<br />
digits (2*n) == digits (3*n),<br />
digits (3*n) == digits (4*n),<br />
digits (4*n) == digits (5*n),<br />
digits (5*n) == digits (6*n)]<br />
where digits = sort . show<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=53 Problem 53] ==<br />
How many values of C(n,r), for 1 ≤ n ≤ 100, exceed one-million?<br />
<br />
Solution:<br />
<haskell><br />
problem_53 = length [n | n <- [1..100], r <- [1..n], n `choose` r > 10^6]<br />
where n `choose` r<br />
| r > n || r < 0 = 0<br />
| otherwise = foldl (\z j -> z*(n-j+1) `div` j) n [2..r]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=54 Problem 54] ==<br />
How many hands did player one win in the game of poker?<br />
<br />
Solution:<br />
<haskell><br />
problem_54 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=55 Problem 55] ==<br />
How many Lychrel numbers are there below ten-thousand?<br />
<br />
Solution:<br />
<haskell><br />
problem_55 = length $ filter isLychrel [1..9999]<br />
where isLychrel n = all notPalindrome (take 50 (tail (iterate revadd n)))<br />
notPalindrome s = (show s) /= reverse (show s)<br />
revadd n = n + rev n<br />
where rev n = read (reverse (show n))<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=56 Problem 56] ==<br />
Considering natural numbers of the form, a<sup>b</sup>, finding the maximum digital sum.<br />
<br />
Solution:<br />
<haskell><br />
problem_56 = maximum [dsum (a^b) | a <- [1..99], b <-[1..99]]<br />
where dsum 0 = 0<br />
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=57 Problem 57] ==<br />
Investigate the expansion of the continued fraction for the square root of two.<br />
<br />
Solution:<br />
<haskell><br />
problem_57 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=58 Problem 58] ==<br />
Investigate the number of primes that lie on the diagonals of the spiral grid.<br />
<br />
Solution:<br />
<haskell><br />
problem_58 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=59 Problem 59] ==<br />
Using a brute force attack, can you decrypt the cipher using XOR encryption?<br />
<br />
Solution:<br />
<haskell><br />
problem_59 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=60 Problem 60] ==<br />
Find a set of five primes for which any two primes concatenate to produce another prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_60 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=12406Euler problems/21 to 302007-04-03T05:39:18Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
This is a little slow because of the naive method used to compute the divisors.<br />
<haskell><br />
problem_21 = sum [m+n | m <- [2..9999], let n = divisorsSum ! m, amicable m n]<br />
where amicable m n = m < n && n < 10000 && divisorsSum ! n == m<br />
divisorsSum = array (1,9999)<br />
[(i, sum (divisors i)) | i <- [1..9999]]<br />
divisors n = [j | j <- [1..n `div` 2], n `mod` j == 0]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
-- apply to a list of names<br />
problem_22 :: [String] -> Int<br />
problem_22 = sum . zipWith (*) [ 1 .. ] . map score<br />
where score = sum . map ( subtract 64 . ord )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_23 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
perms [] = [[]]<br />
perms xs = do<br />
x <- xs<br />
map ( x: ) ( perms . delete x $ xs )<br />
<br />
problem_24 = ( perms "0123456789" ) !! 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = fst $ maximumBy (\a b -> snd a `compare` snd b)<br />
[(n,recurringCycle n) | n <- [1..999]]<br />
where recurringCycle d = remainders d 10 []<br />
remainders d 0 rs = 0<br />
remainders d r rs = let r' = r `mod` d<br />
in case findIndex (== r') rs of<br />
Just i -> i + 1<br />
Nothing -> remainders d (10*r') (r':rs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
problem_29 = length . group . sort $ [a^b | a <- [2..100], b <- [2..100]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_30 = undefined<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/91_to_100&diff=12404Euler problems/91 to 1002007-04-02T19:56:40Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=97 Problem 97] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=91 Problem 91] ==<br />
Find the number of right angle triangles in the quadrant.<br />
<br />
Solution:<br />
<haskell><br />
problem_91 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=92 Problem 92] ==<br />
Investigating a square digits number chain with a surprising property.<br />
<br />
Solution:<br />
<haskell><br />
problem_92 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=93 Problem 93] ==<br />
Using four distinct digits and the rules of arithmetic, find the longest sequence of target numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_93 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=94 Problem 94] ==<br />
Investigating almost equilateral triangles with integral sides and area.<br />
<br />
Solution:<br />
<haskell><br />
problem_94 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=95 Problem 95] ==<br />
Find the smallest member of the longest amicable chain with no element exceeding one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_95 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=96 Problem 96] ==<br />
Devise an algorithm for solving Su Doku puzzles.<br />
<br />
Solution:<br />
<haskell><br />
problem_96 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=97 Problem 97] ==<br />
Find the last ten digits of the non-Mersenne prime: 28433 × 2<sup>7830457</sup> + 1.<br />
<br />
Solution:<br />
<haskell><br />
problem_97 = (28433 * 2^7830457 + 1) `mod` (10^10)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=98 Problem 98] ==<br />
Investigating words, and their anagrams, which can represent square numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_98 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=99 Problem 99] ==<br />
Which base/exponent pair in the file has the greatest numerical value?<br />
<br />
Solution:<br />
<haskell><br />
problem_99 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=100 Problem 100] ==<br />
Finding the number of blue discs for which there is 50% chance of taking two blue.<br />
<br />
Solution:<br />
<haskell><br />
problem_100 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/71_to_80&diff=12378Euler problems/71 to 802007-03-30T08:48:08Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=75 Problem 75] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=71 Problem 71] ==<br />
Listing reduced proper fractions in ascending order of size.<br />
<br />
Solution:<br />
<haskell><br />
problem_71 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=72 Problem 72] ==<br />
How many elements would be contained in the set of reduced proper fractions for d ≤ 1,000,000?<br />
<br />
Solution:<br />
<haskell><br />
problem_72 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=73 Problem 73] ==<br />
How many fractions lie between 1/3 and 1/2 in a sorted set of reduced proper fractions?<br />
<br />
Solution:<br />
<haskell><br />
problem_73 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=74 Problem 74] ==<br />
Determine the number of factorial chains that contain exactly sixty non-repeating terms.<br />
<br />
Solution:<br />
<haskell><br />
problem_74 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=75 Problem 75] ==<br />
Find the number of different lengths of wire can that can form a right angle triangle in only one way.<br />
<br />
Solution:<br />
This is only slightly harder than [[Euler problems/31 to 40#39|problem 39]]. The search condition is simpler but the search space is larger.<br />
<haskell><br />
problem_75 = length . filter ((== 1) . length) $ group perims<br />
where perims = sort [scale*p | p <- pTriples, scale <- [1..10^6 `div` p]]<br />
pTriples = [p |<br />
n <- [1..1000],<br />
m <- [n+1..1000],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p <= 10^6]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=76 Problem 76] ==<br />
How many different ways can one hundred be written as a sum of at least two positive integers?<br />
<br />
Solution:<br />
<haskell><br />
problem_76 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=77 Problem 77] ==<br />
What is the first value which can be written as the sum of primes in over five thousand different ways?<br />
<br />
Solution:<br />
<haskell><br />
problem_77 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=78 Problem 78] ==<br />
Investigating the number of ways in which coins can be separated into piles.<br />
<br />
Solution:<br />
<haskell><br />
problem_78 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=79 Problem 79] ==<br />
By analysing a user's login attempts, can you determine the secret numeric passcode?<br />
<br />
Solution:<br />
<haskell><br />
problem_79 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=80 Problem 80] ==<br />
Calculating the digital sum of the decimal digits of irrational square roots.<br />
<br />
Solution:<br />
<haskell><br />
problem_80 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=12377Euler problems/31 to 402007-03-30T08:39:32Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] */ reduce search space</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of memoization, dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = pence 200 [1,2,5,10,20,50,100,200]<br />
where pence 0 _ = 1<br />
pence n [] = 0<br />
pence n denominations@(d:ds)<br />
| n < d = 0<br />
| otherwise = pence (n - d) denominations<br />
+ pence n ds<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
problem_32 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
problem_33 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_34 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
problem_35 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
problem_36 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
problem_37 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
problem_38 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..floor (sqrt 1000)],<br />
m <- [n+1..floor (sqrt 1000)],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/71_to_80&diff=12376Euler problems/71 to 802007-03-30T08:35:22Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=75 Problem 75] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=71 Problem 71] ==<br />
Listing reduced proper fractions in ascending order of size.<br />
<br />
Solution:<br />
<haskell><br />
problem_71 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=72 Problem 72] ==<br />
How many elements would be contained in the set of reduced proper fractions for d ≤ 1,000,000?<br />
<br />
Solution:<br />
<haskell><br />
problem_72 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=73 Problem 73] ==<br />
How many fractions lie between 1/3 and 1/2 in a sorted set of reduced proper fractions?<br />
<br />
Solution:<br />
<haskell><br />
problem_73 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=74 Problem 74] ==<br />
Determine the number of factorial chains that contain exactly sixty non-repeating terms.<br />
<br />
Solution:<br />
<haskell><br />
problem_74 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=75 Problem 75] ==<br />
Find the number of different lengths of wire can that can form a right angle triangle in only one way.<br />
<br />
Solution:<br />
<haskell><br />
problem_75 = length . filter ((== 1) . length) $ perims<br />
where perims = group $ sort [scale*p | p <- pTriples, scale <- [1..10^6 `div` p]]<br />
pTriples = [p |<br />
n <- [1..1000],<br />
m <- [n+1..1000],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p <= 10^6]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=76 Problem 76] ==<br />
How many different ways can one hundred be written as a sum of at least two positive integers?<br />
<br />
Solution:<br />
<haskell><br />
problem_76 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=77 Problem 77] ==<br />
What is the first value which can be written as the sum of primes in over five thousand different ways?<br />
<br />
Solution:<br />
<haskell><br />
problem_77 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=78 Problem 78] ==<br />
Investigating the number of ways in which coins can be separated into piles.<br />
<br />
Solution:<br />
<haskell><br />
problem_78 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=79 Problem 79] ==<br />
By analysing a user's login attempts, can you determine the secret numeric passcode?<br />
<br />
Solution:<br />
<haskell><br />
problem_79 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=80 Problem 80] ==<br />
Calculating the digital sum of the decimal digits of irrational square roots.<br />
<br />
Solution:<br />
<haskell><br />
problem_80 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/51_to_60&diff=12373Euler problems/51 to 602007-03-30T07:39:54Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=53 Problem 53] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=51 Problem 51] ==<br />
Find the smallest prime which, by changing the same part of the number, can form eight different primes.<br />
<br />
Solution:<br />
<haskell><br />
problem_51 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=52 Problem 52] ==<br />
Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x, contain the same digits in some order.<br />
<br />
Solution:<br />
<haskell><br />
problem_52 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=53 Problem 53] ==<br />
How many values of C(n,r), for 1 ≤ n ≤ 100, exceed one-million?<br />
<br />
Solution:<br />
<haskell><br />
problem_53 = length [n | n <- [1..100], r <- [1..n], n `choose` r > 10^6]<br />
where n `choose` r<br />
| r > n || r < 0 = 0<br />
| otherwise = foldl (\z j -> z*(n-j+1) `div` j) n [2..r]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=54 Problem 54] ==<br />
How many hands did player one win in the game of poker?<br />
<br />
Solution:<br />
<haskell><br />
problem_54 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=55 Problem 55] ==<br />
How many Lychrel numbers are there below ten-thousand?<br />
<br />
Solution:<br />
<haskell><br />
problem_55 = length $ filter isLychrel [1..9999]<br />
where isLychrel n = all notPalindrome (take 50 (tail (iterate revadd n)))<br />
notPalindrome s = (show s) /= reverse (show s)<br />
revadd n = n + rev n<br />
where rev n = read (reverse (show n))<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=56 Problem 56] ==<br />
Considering natural numbers of the form, a<sup>b</sup>, finding the maximum digital sum.<br />
<br />
Solution:<br />
<haskell><br />
problem_56 = maximum [dsum (a^b) | a <- [1..99], b <-[1..99]]<br />
where dsum 0 = 0<br />
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=57 Problem 57] ==<br />
Investigate the expansion of the continued fraction for the square root of two.<br />
<br />
Solution:<br />
<haskell><br />
problem_57 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=58 Problem 58] ==<br />
Investigate the number of primes that lie on the diagonals of the spiral grid.<br />
<br />
Solution:<br />
<haskell><br />
problem_58 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=59 Problem 59] ==<br />
Using a brute force attack, can you decrypt the cipher using XOR encryption?<br />
<br />
Solution:<br />
<haskell><br />
problem_59 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=60 Problem 60] ==<br />
Find a set of five primes for which any two primes concatenate to produce another prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_60 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/51_to_60&diff=12371Euler problems/51 to 602007-03-30T07:24:44Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=56 Problem 56] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=51 Problem 51] ==<br />
Find the smallest prime which, by changing the same part of the number, can form eight different primes.<br />
<br />
Solution:<br />
<haskell><br />
problem_51 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=52 Problem 52] ==<br />
Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x, contain the same digits in some order.<br />
<br />
Solution:<br />
<haskell><br />
problem_52 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=53 Problem 53] ==<br />
How many values of C(n,r), for 1 ≤ n ≤ 100, exceed one-million?<br />
<br />
Solution:<br />
<haskell><br />
problem_53 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=54 Problem 54] ==<br />
How many hands did player one win in the game of poker?<br />
<br />
Solution:<br />
<haskell><br />
problem_54 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=55 Problem 55] ==<br />
How many Lychrel numbers are there below ten-thousand?<br />
<br />
Solution:<br />
<haskell><br />
problem_55 = length $ filter isLychrel [1..9999]<br />
where isLychrel n = all notPalindrome (take 50 (tail (iterate revadd n)))<br />
notPalindrome s = (show s) /= reverse (show s)<br />
revadd n = n + rev n<br />
where rev n = read (reverse (show n))<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=56 Problem 56] ==<br />
Considering natural numbers of the form, a<sup>b</sup>, finding the maximum digital sum.<br />
<br />
Solution:<br />
<haskell><br />
problem_56 = maximum [dsum (a^b) | a <- [1..99], b <-[1..99]]<br />
where dsum 0 = 0<br />
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=57 Problem 57] ==<br />
Investigate the expansion of the continued fraction for the square root of two.<br />
<br />
Solution:<br />
<haskell><br />
problem_57 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=58 Problem 58] ==<br />
Investigate the number of primes that lie on the diagonals of the spiral grid.<br />
<br />
Solution:<br />
<haskell><br />
problem_58 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=59 Problem 59] ==<br />
Using a brute force attack, can you decrypt the cipher using XOR encryption?<br />
<br />
Solution:<br />
<haskell><br />
problem_59 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=60 Problem 60] ==<br />
Find a set of five primes for which any two primes concatenate to produce another prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_60 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=12370Euler problems/21 to 302007-03-30T07:19:12Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
This is a little slow because of the naive method used to compute the divisors.<br />
<haskell><br />
problem_21 = sum [m+n | m <- [2..9999], let n = divisorsSum ! m, amicable m n]<br />
where amicable m n = m < n && n < 10000 && divisorsSum ! n == m<br />
divisorsSum = array (1,9999)<br />
[(i, sum (divisors i)) | i <- [1..9999]]<br />
divisors n = [j | j <- [1..n `div` 2], n `mod` j == 0]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
-- apply to a list of names<br />
problem_22 :: [String] -> Int<br />
problem_22 = sum . zipWith (*) [ 1 .. ] . map score<br />
where score = sum . map ( subtract 64 . ord )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_23 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
perms [] = [[]]<br />
perms xs = do<br />
x <- xs<br />
map ( x: ) ( perms . delete x $ xs )<br />
<br />
problem_24 = ( perms "0123456789" ) !! 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
problem_29 = length . group . sort $ [a^b | a <- [2..100], b <- [2..100]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_30 = undefined<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=12367Euler problems/21 to 302007-03-30T06:43:25Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution:<br />
<haskell><br />
problem_21 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
-- apply to a list of names<br />
problem_22 :: [String] -> Int<br />
problem_22 = sum . zipWith (*) [ 1 .. ] . map score<br />
where score = sum . map ( subtract 64 . ord )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_23 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
perms [] = [[]]<br />
perms xs = do<br />
x <- xs<br />
map ( x: ) ( perms . delete x $ xs )<br />
<br />
problem_24 = ( perms "0123456789" ) !! 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
valid ( i, n ) = length ( show n ) == 1000<br />
<br />
problem_25 = fst . head . filter valid . zip [ 1 .. ] $ fibs<br />
where fibs = 1 : 1 : 2 : zipWith (+) fibs ( tail fibs )<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
problem_29 = length . group . sort $ [a^b | a <- [2..100], b <- [2..100]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_30 = undefined<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/51_to_60&diff=12366Euler problems/51 to 602007-03-30T06:39:11Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=55 Problem 55] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=51 Problem 51] ==<br />
Find the smallest prime which, by changing the same part of the number, can form eight different primes.<br />
<br />
Solution:<br />
<haskell><br />
problem_51 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=52 Problem 52] ==<br />
Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x, contain the same digits in some order.<br />
<br />
Solution:<br />
<haskell><br />
problem_52 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=53 Problem 53] ==<br />
How many values of C(n,r), for 1 ≤ n ≤ 100, exceed one-million?<br />
<br />
Solution:<br />
<haskell><br />
problem_53 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=54 Problem 54] ==<br />
How many hands did player one win in the game of poker?<br />
<br />
Solution:<br />
<haskell><br />
problem_54 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=55 Problem 55] ==<br />
How many Lychrel numbers are there below ten-thousand?<br />
<br />
Solution:<br />
<haskell><br />
problem_55 = length $ filter isLychrel [1..9999]<br />
where isLychrel n = all notPalindrome (take 50 (tail (iterate revadd n)))<br />
notPalindrome s = (show s) /= reverse (show s)<br />
revadd n = n + rev n<br />
where rev n = read (reverse (show n))<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=56 Problem 56] ==<br />
Considering natural numbers of the form, ab, finding the maximum digital sum.<br />
<br />
Solution:<br />
<haskell><br />
problem_56 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=57 Problem 57] ==<br />
Investigate the expansion of the continued fraction for the square root of two.<br />
<br />
Solution:<br />
<haskell><br />
problem_57 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=58 Problem 58] ==<br />
Investigate the number of primes that lie on the diagonals of the spiral grid.<br />
<br />
Solution:<br />
<haskell><br />
problem_58 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=59 Problem 59] ==<br />
Using a brute force attack, can you decrypt the cipher using XOR encryption?<br />
<br />
Solution:<br />
<haskell><br />
problem_59 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=60 Problem 60] ==<br />
Find a set of five primes for which any two primes concatenate to produce another prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_60 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=12358Euler problems/31 to 402007-03-30T04:14:05Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] */ a solution (could use some cleanup)</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of memoization, dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = pence 200 [1,2,5,10,20,50,100,200]<br />
where pence 0 _ = 1<br />
pence n [] = 0<br />
pence n denominations@(d:ds)<br />
| n < d = 0<br />
| otherwise = pence (n - d) denominations<br />
+ pence n ds<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
problem_32 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
problem_33 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_34 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
problem_35 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
problem_36 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
problem_37 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
problem_38 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
We use the well known formula to generate primitive Pythagorean triples. All we need are the perimeters, and they have to be scaled to produce all triples in the problem space.<br />
<haskell><br />
problem_39 = head $ perims !! indexMax<br />
where perims = group<br />
$ sort [n*p | p <- pTriples, n <- [1..1000 `div` p]]<br />
counts = map length perims<br />
Just indexMax = findIndex (== (maximum counts)) $ counts<br />
pTriples = [p |<br />
n <- [1..250],<br />
m <- [n+1..250],<br />
even n || even m,<br />
gcd n m == 1,<br />
let a = m^2 - n^2,<br />
let b = 2*m*n,<br />
let c = m^2 + n^2,<br />
let p = a + b + c,<br />
p < 1000]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/41_to_50&diff=12354Euler problems/41 to 502007-03-30T01:57:57Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] */</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==<br />
What is the largest n-digit pandigital prime that exists?<br />
<br />
Solution:<br />
<haskell><br />
problem_41 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=42 Problem 42] ==<br />
How many triangle words can you make using the list of common English words?<br />
<br />
Solution:<br />
<haskell><br />
problem_42 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=43 Problem 43] ==<br />
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.<br />
<br />
Solution:<br />
<haskell><br />
problem_43 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=44 Problem 44] ==<br />
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.<br />
<br />
Solution:<br />
<haskell><br />
problem_44 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] ==<br />
After 40755, what is the next triangle number that is also pentagonal and hexagonal?<br />
<br />
Solution:<br />
<haskell><br />
problem_45 = head . dropWhile (<= 40755) $ match tries (match pents hexes)<br />
where match (x:xs) (y:ys)<br />
| x < y = match xs (y:ys)<br />
| y < x = match (x:xs) ys<br />
| otherwise = x : match xs ys<br />
tries = [n*(n+1) `div` 2 | n <- [1..]]<br />
pents = [n*(3*n-1) `div` 2 | n <- [1..]]<br />
hexes = [n*(2*n-1) | n <- [1..]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] ==<br />
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?<br />
<br />
Solution:<br />
<br />
This solution is inspired by exercise 3.70 in ''Structure and Interpretation of Computer Programs'', (2nd ed.).<br />
<br />
<haskell><br />
problem_46 = head $ oddComposites `orderedDiff` gbSums<br />
<br />
oddComposites = filter ((>1) . length . primeFactors) [3,5..]<br />
<br />
gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n | n <- [1..]]<br />
gbWeight (a,b) = a + b<br />
<br />
weightedPairs w (x:xs) (y:ys) =<br />
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))<br />
<br />
mergeWeighted w (x:xs) (y:ys)<br />
| w x <= w y = x : mergeWeighted w xs (y:ys)<br />
| otherwise = y : mergeWeighted w (x:xs) ys<br />
<br />
x `orderedDiff` [] = x<br />
[] `orderedDiff` y = []<br />
(x:xs) `orderedDiff` (y:ys)<br />
| x < y = x : xs `orderedDiff` (y:ys)<br />
| x > y = (x:xs) `orderedDiff` ys<br />
| otherwise = xs `orderedDiff` ys<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=47 Problem 47] ==<br />
Find the first four consecutive integers to have four distinct primes factors.<br />
<br />
Solution:<br />
<haskell><br />
problem_47 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] ==<br />
Find the last ten digits of 1<sup>1</sup> + 2<sup>2</sup> + ... + 1000<sup>1000</sup>.<br />
<br />
Solution:<br />
If the problem were more computationally intensive, [http://en.wikipedia.org/wiki/Modular_exponentiation modular exponentiation] might be appropriate. With this problem size the naive approach is sufficient.<br />
<haskell><br />
problem_48 = sum [n^n | n <- [1..1000]] `mod` 10^10<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=49 Problem 49] ==<br />
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.<br />
<br />
Solution:<br />
<haskell><br />
problem_49 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=50 Problem 50] ==<br />
Which prime, below one-million, can be written as the sum of the most consecutive primes?<br />
<br />
Solution:<br />
<haskell><br />
problem_50 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/41_to_50&diff=12353Euler problems/41 to 502007-03-30T01:55:27Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==<br />
What is the largest n-digit pandigital prime that exists?<br />
<br />
Solution:<br />
<haskell><br />
problem_41 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=42 Problem 42] ==<br />
How many triangle words can you make using the list of common English words?<br />
<br />
Solution:<br />
<haskell><br />
problem_42 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=43 Problem 43] ==<br />
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.<br />
<br />
Solution:<br />
<haskell><br />
problem_43 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=44 Problem 44] ==<br />
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.<br />
<br />
Solution:<br />
<haskell><br />
problem_44 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] ==<br />
After 40755, what is the next triangle number that is also pentagonal and hexagonal?<br />
<br />
Solution:<br />
<haskell><br />
problem_45 = head . dropWhile (<= 40755) $ match tries (match pents hexes)<br />
where match (x:xs) (y:ys)<br />
| x < y = match xs (y:ys)<br />
| y < x = match (x:xs) ys<br />
| otherwise = x : match xs ys<br />
tries = [n*(n+1) `div` 2 | n <- [1..]]<br />
pents = [n*(3*n-1) `div` 2 | n <- [1..]]<br />
hexes = [n*(2*n-1) | n <- [1..]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] ==<br />
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?<br />
<br />
Solution:<br />
<br />
This solution is inspired by exercise 3.70 in ''Structure and Interpretation of Computer Programs'', (2nd ed.).<br />
<br />
<haskell><br />
problem_46 = head $ oddComposites `orderedDiff` gbSums<br />
<br />
oddComposites = filter ((>1) . length . primeFactors) [3,5..]<br />
<br />
gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n | n <- [1..]]<br />
gbWeight (a,b) = a + b<br />
<br />
weightedPairs w (x:xs) (y:ys) =<br />
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))<br />
<br />
mergeWeighted w (x:xs) (y:ys)<br />
| w x <= w y = x : mergeWeighted w xs (y:ys)<br />
| otherwise = y : mergeWeighted w (x:xs) ys<br />
<br />
x `orderedDiff` [] = x<br />
[] `orderedDiff` y = []<br />
(x:xs) `orderedDiff` (y:ys)<br />
| x < y = x : xs `orderedDiff` (y:ys)<br />
| x > y = (x:xs) `orderedDiff` ys<br />
| otherwise = xs `orderedDiff` ys<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=47 Problem 47] ==<br />
Find the first four consecutive integers to have four distinct primes factors.<br />
<br />
Solution:<br />
<haskell><br />
problem_47 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] ==<br />
Find the last ten digits of 1<sup>1</sup> + 2<sup>2</sup> + ... + 1000<sup>1000</sup>.<br />
<br />
Solution:<br />
If the problem were more computationally intensive, [http://en.wikipedia.org/wiki/Modular_exponentiation modular exponentiation] might be appropriate. As it is, ghci will return the result using the naive approach almost instantly.<br />
<haskell><br />
problem_48 = sum [n^n | n <- [1..1000]] `mod` 10^10<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=49 Problem 49] ==<br />
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.<br />
<br />
Solution:<br />
<haskell><br />
problem_49 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=50 Problem 50] ==<br />
Which prime, below one-million, can be written as the sum of the most consecutive primes?<br />
<br />
Solution:<br />
<haskell><br />
problem_50 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/41_to_50&diff=12352Euler problems/41 to 502007-03-30T01:29:38Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==<br />
What is the largest n-digit pandigital prime that exists?<br />
<br />
Solution:<br />
<haskell><br />
problem_41 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=42 Problem 42] ==<br />
How many triangle words can you make using the list of common English words?<br />
<br />
Solution:<br />
<haskell><br />
problem_42 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=43 Problem 43] ==<br />
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.<br />
<br />
Solution:<br />
<haskell><br />
problem_43 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=44 Problem 44] ==<br />
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.<br />
<br />
Solution:<br />
<haskell><br />
problem_44 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] ==<br />
After 40755, what is the next triangle number that is also pentagonal and hexagonal?<br />
<br />
Solution:<br />
<haskell><br />
problem_45 = head . dropWhile (<= 40755) $ match tries (match pents hexes)<br />
where match (x:xs) (y:ys)<br />
| x < y = match xs (y:ys)<br />
| y < x = match (x:xs) ys<br />
| otherwise = x : match xs ys<br />
tries = [n*(n+1) `div` 2 | n <- [1..]]<br />
pents = [n*(3*n-1) `div` 2 | n <- [1..]]<br />
hexes = [n*(2*n-1) | n <- [1..]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] ==<br />
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?<br />
<br />
Solution:<br />
<br />
This solution is inspired by exercise 3.70 in ''Structure and Interpretation of Computer Programs'', (2nd ed.).<br />
<br />
<haskell><br />
problem_46 = head $ oddComposites `orderedDiff` gbSums<br />
<br />
oddComposites = filter ((>1) . length . primeFactors) [3,5..]<br />
<br />
gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n | n <- [1..]]<br />
gbWeight (a,b) = a + b<br />
<br />
weightedPairs w (x:xs) (y:ys) =<br />
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))<br />
<br />
mergeWeighted w (x:xs) (y:ys)<br />
| w x <= w y = x : mergeWeighted w xs (y:ys)<br />
| otherwise = y : mergeWeighted w (x:xs) ys<br />
<br />
x `orderedDiff` [] = x<br />
[] `orderedDiff` y = []<br />
(x:xs) `orderedDiff` (y:ys)<br />
| x < y = x : xs `orderedDiff` (y:ys)<br />
| x > y = (x:xs) `orderedDiff` ys<br />
| otherwise = xs `orderedDiff` ys<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=47 Problem 47] ==<br />
Find the first four consecutive integers to have four distinct primes factors.<br />
<br />
Solution:<br />
<haskell><br />
problem_47 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] ==<br />
Find the last ten digits of 11 + 22 + ... + 10001000.<br />
<br />
Solution:<br />
<haskell><br />
problem_48 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=49 Problem 49] ==<br />
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.<br />
<br />
Solution:<br />
<haskell><br />
problem_49 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=50 Problem 50] ==<br />
Which prime, below one-million, can be written as the sum of the most consecutive primes?<br />
<br />
Solution:<br />
<haskell><br />
problem_50 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/61_to_70&diff=12350Euler problems/61 to 702007-03-30T01:03:54Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=63 Problem 63] */ a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=61 Problem 61] ==<br />
Find the sum of the only set of six 4-digit figurate numbers with a cyclic property.<br />
<br />
Solution:<br />
<haskell><br />
problem_61 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=62 Problem 62] ==<br />
Find the smallest cube for which exactly five permutations of its digits are cube.<br />
<br />
Solution:<br />
<haskell><br />
problem_62 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=63 Problem 63] ==<br />
How many n-digit positive integers exist which are also an nth power?<br />
<br />
Solution:<br />
Since d<sup>n</sup> has at least n+1 digits for any d≥10, we need only consider 1 through 9. If d<sup>n</sup> has fewer than n digits, every higher power of d will also be too small since d < 10. We will also never have n+1 digits for our nth powers. All we have to do is check d<sup>n</sup> for each d in {1,...,9}, trying n=1,2,... and stopping when d<sup>n</sup> has fewer than n digits.<br />
<haskell><br />
problem_63 = length . concatMap (takeWhile (\(n,p) -> n == nDigits p))<br />
$ [powers d | d <- [1..9]]<br />
where powers d = [(n, d^n) | n <- [1..]]<br />
nDigits n = length (show n)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=64 Problem 64] ==<br />
How many continued fractions for N ≤ 10000 have an odd period?<br />
<br />
Solution:<br />
<haskell><br />
problem_64 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=65 Problem 65] ==<br />
Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e.<br />
<br />
Solution:<br />
<haskell><br />
problem_65 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=66 Problem 66] ==<br />
Investigate the Diophantine equation x<sup>2</sup> − Dy<sup>2</sup> = 1.<br />
<br />
Solution:<br />
<haskell><br />
problem_66 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=67 Problem 67] ==<br />
Using an efficient algorithm find the maximal sum in the triangle?<br />
<br />
Solution:<br />
<haskell><br />
problem_67 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=68 Problem 68] ==<br />
What is the maximum 16-digit string for a "magic" 5-gon ring?<br />
<br />
Solution:<br />
<haskell><br />
problem_68 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=69 Problem 69] ==<br />
Find the value of n ≤ 1,000,000 for which n/φ(n) is a maximum.<br />
<br />
Solution:<br />
<haskell><br />
problem_69 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=70 Problem 70] ==<br />
Investigate values of n for which φ(n) is a permutation of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_70 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/61_to_70&diff=12328Euler problems/61 to 702007-03-29T03:20:30Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=66 Problem 66] */ eqn fix</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=61 Problem 61] ==<br />
Find the sum of the only set of six 4-digit figurate numbers with a cyclic property.<br />
<br />
Solution:<br />
<haskell><br />
problem_61 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=62 Problem 62] ==<br />
Find the smallest cube for which exactly five permutations of its digits are cube.<br />
<br />
Solution:<br />
<haskell><br />
problem_62 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=63 Problem 63] ==<br />
How many n-digit positive integers exist which are also an nth power?<br />
<br />
Solution:<br />
<haskell><br />
problem_63 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=64 Problem 64] ==<br />
How many continued fractions for N ≤ 10000 have an odd period?<br />
<br />
Solution:<br />
<haskell><br />
problem_64 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=65 Problem 65] ==<br />
Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e.<br />
<br />
Solution:<br />
<haskell><br />
problem_65 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=66 Problem 66] ==<br />
Investigate the Diophantine equation x<sup>2</sup> − Dy<sup>2</sup> = 1.<br />
<br />
Solution:<br />
<haskell><br />
problem_66 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=67 Problem 67] ==<br />
Using an efficient algorithm find the maximal sum in the triangle?<br />
<br />
Solution:<br />
<haskell><br />
problem_67 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=68 Problem 68] ==<br />
What is the maximum 16-digit string for a "magic" 5-gon ring?<br />
<br />
Solution:<br />
<haskell><br />
problem_68 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=69 Problem 69] ==<br />
Find the value of n ≤ 1,000,000 for which n/φ(n) is a maximum.<br />
<br />
Solution:<br />
<haskell><br />
problem_69 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=70 Problem 70] ==<br />
Investigate values of n for which φ(n) is a permutation of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_70 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=12290Euler problems/31 to 402007-03-28T14:22:08Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] */ naive doubly recursive solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<br />
This is the naive doubly recursive solution. Speed would be greatly improved by use of memoization, dynamic programming, or the closed form.<br />
<haskell><br />
problem_31 = pence 200 [1,2,5,10,20,50,100,200]<br />
where pence 0 _ = 1<br />
pence n [] = 0<br />
pence n denominations@(d:ds)<br />
| n < d = 0<br />
| otherwise = pence (n - d) denominations<br />
+ pence n ds<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
problem_32 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
problem_33 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_34 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
problem_35 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
problem_36 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
problem_37 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
problem_38 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
<haskell><br />
problem_39 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/31_to_40&diff=12287Euler problems/31 to 402007-03-28T13:56:35Z<p>Quale: fix typo</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=31 Problem 31] ==<br />
Investigating combinations of English currency denominations.<br />
<br />
Solution:<br />
<haskell><br />
problem_31 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=32 Problem 32] ==<br />
Find the sum of all numbers that can be written as pandigital products.<br />
<br />
Solution:<br />
<haskell><br />
problem_32 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=33 Problem 33] ==<br />
Discover all the fractions with an unorthodox cancelling method.<br />
<br />
Solution:<br />
<haskell><br />
problem_33 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=34 Problem 34] ==<br />
Find the sum of all numbers which are equal to the sum of the factorial of their digits.<br />
<br />
Solution:<br />
<haskell><br />
problem_34 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=35 Problem 35] ==<br />
How many circular primes are there below one million?<br />
<br />
Solution:<br />
<haskell><br />
problem_35 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=36 Problem 36] ==<br />
Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.<br />
<br />
Solution:<br />
<haskell><br />
problem_36 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=37 Problem 37] ==<br />
Find the sum of all eleven primes that are both truncatable from left to right and right to left.<br />
<br />
Solution:<br />
<haskell><br />
problem_37 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=38 Problem 38] ==<br />
What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?<br />
<br />
Solution:<br />
<haskell><br />
problem_38 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=39 Problem 39] ==<br />
If p is the perimeter of a right angle triangle, {a, b, c}, which value, for p ≤ 1000, has the most solutions?<br />
<br />
Solution:<br />
<haskell><br />
problem_39 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=40 Problem 40] ==<br />
Finding the nth digit of the fractional part of the irrational number.<br />
<br />
Solution:<br />
<haskell><br />
problem_40 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/41_to_50&diff=12282Euler problems/41 to 502007-03-28T05:02:37Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] */ solution inspired by SICP exercise 3.70</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=41 Problem 41] ==<br />
What is the largest n-digit pandigital prime that exists?<br />
<br />
Solution:<br />
<haskell><br />
problem_41 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=42 Problem 42] ==<br />
How many triangle words can you make using the list of common English words?<br />
<br />
Solution:<br />
<haskell><br />
problem_42 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=43 Problem 43] ==<br />
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.<br />
<br />
Solution:<br />
<haskell><br />
problem_43 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=44 Problem 44] ==<br />
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.<br />
<br />
Solution:<br />
<haskell><br />
problem_44 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=45 Problem 45] ==<br />
After 40755, what is the next triangle number that is also pentagonal and hexagonal?<br />
<br />
Solution:<br />
<haskell><br />
problem_45 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=46 Problem 46] ==<br />
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?<br />
<br />
Solution:<br />
<br />
This solution is inspired by exercise 3.70 in ''Structure and Interpretation of Computer Programs'', (2nd ed.).<br />
<br />
<haskell><br />
problem_46 = head $ oddComposites `orderedDiff` gbSums<br />
<br />
oddComposites = filter ((>1) . length . primeFactors) [3,5..]<br />
<br />
gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n | n <- [1..]]<br />
gbWeight (a,b) = a + b<br />
<br />
weightedPairs w (x:xs) (y:ys) =<br />
(x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys))<br />
<br />
mergeWeighted w (x:xs) (y:ys)<br />
| w x <= w y = x : mergeWeighted w xs (y:ys)<br />
| otherwise = y : mergeWeighted w (x:xs) ys<br />
<br />
x `orderedDiff` [] = x<br />
[] `orderedDiff` y = []<br />
(x:xs) `orderedDiff` (y:ys)<br />
| x < y = x : xs `orderedDiff` (y:ys)<br />
| x > y = (x:xs) `orderedDiff` ys<br />
| otherwise = xs `orderedDiff` ys<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=47 Problem 47] ==<br />
Find the first four consecutive integers to have four distinct primes factors.<br />
<br />
Solution:<br />
<haskell><br />
problem_47 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=48 Problem 48] ==<br />
Find the last ten digits of 11 + 22 + ... + 10001000.<br />
<br />
Solution:<br />
<haskell><br />
problem_48 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=49 Problem 49] ==<br />
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.<br />
<br />
Solution:<br />
<haskell><br />
problem_49 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=50 Problem 50] ==<br />
Which prime, below one-million, can be written as the sum of the most consecutive primes?<br />
<br />
Solution:<br />
<haskell><br />
problem_50 = undefined<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=12276Euler problems/11 to 202007-03-28T01:33:41Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] */ add a solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the 20 by 20 grid?<br />
<br />
Solution:<br />
<haskell><br />
problem_11 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where triangleNumbers = scanl1 (+) [1..]<br />
nDivisors n = product $ map ((+1) . length) (group (primeFactors n))<br />
primes = 2 : filter ((== 1) . length . primeFactors) [3,5..]<br />
primeFactors n = factor n primes<br />
where factor n (p:ps) | p*p > n = [n]<br />
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)<br />
| otherwise = factor n ps<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_13 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_14 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
<haskell><br />
problem_15 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
problem_16 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
problem_17 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=19 Problem 19] ==<br />
How many Sundays fell on the first of the month during the twentieth century?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = undefined<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/1_to_10&diff=12275Euler problems/1 to 102007-03-27T18:03:10Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] */ use last instead of maximum</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] ==<br />
Add all the natural numbers below 1000 that are multiples of 3 or 5.<br />
<br />
Solution:<br />
<haskell><br />
problem_1 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=2 Problem 2] ==<br />
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, x `mod` 2 == 0]<br />
where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] ==<br />
Find the largest prime factor of 317584931803.<br />
<br />
Solution:<br />
<haskell><br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
primeFactors n = factor n primes<br />
where factor n (p:ps) | p*p > n = [n]<br />
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)<br />
| otherwise = factor n ps<br />
<br />
problem_3 = last (primeFactors 317584931803)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==<br />
Find the largest palindrome made from the product of two 3-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_4 = foldr max 0 [ x | y <- [100..999], z <- [100..999], let x = y * z, let s = show x, s == reverse s]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] ==<br />
What is the smallest number divisible by each of the numbers 1 to 20?<br />
<br />
Solution:<br />
<haskell><br />
problem_5 = head [ x | x <- [2520,5040..], all (\y -> x `mod` y == 0) [1..20]]<br />
</haskell><br />
An alternative solution that takes advantage of the Prelude to avoid use of the generate and test idiom:<br />
<haskell><br />
problem_5' = foldr1 lcm [1..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=6 Problem 6] ==<br />
What is the difference between the sum of the squares and the square of the sums?<br />
<br />
Solution:<br />
<haskell><br />
problem_6 = sum [ x^2 | x <- [1..100]] - (sum [1..100])^2<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=7 Problem 7] ==<br />
Find the 10001st prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_7 = head $ drop 10000 primes<br />
where primes = 2:3:..<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==<br />
Discover the largest product of five consecutive digits in the 1000-digit number.<br />
<br />
Solution:<br />
<haskell><br />
problem_8 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=9 Problem 9] ==<br />
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.<br />
<br />
Solution:<br />
<haskell><br />
problem_9 = head [a*b*c | a <- [1..500], b <- [a..500], let c = 1000-a-b, a^2 + b^2 == c^2]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=10 Problem 10] ==<br />
Calculate the sum of all the primes below one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_10 = sum (takeWhile (< 1000000) primes)<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/1_to_10&diff=12274Euler problems/1 to 102007-03-27T17:51:31Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] */ bug fix (previously found largest proper divisor 67*3919, not prime)</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] ==<br />
Add all the natural numbers below 1000 that are multiples of 3 or 5.<br />
<br />
Solution:<br />
<haskell><br />
problem_1 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=2 Problem 2] ==<br />
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, x `mod` 2 == 0]<br />
where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] ==<br />
Find the largest prime factor of 317584931803.<br />
<br />
Solution:<br />
<haskell><br />
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]<br />
primeFactors n = factor n primes<br />
where factor n (p:ps) | p*p > n = [n]<br />
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)<br />
| otherwise = factor n ps<br />
<br />
problem_3 = maximum (primeFactors 317584931803)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==<br />
Find the largest palindrome made from the product of two 3-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_4 = foldr max 0 [ x | y <- [100..999], z <- [100..999], let x = y * z, let s = show x, s == reverse s]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] ==<br />
What is the smallest number divisible by each of the numbers 1 to 20?<br />
<br />
Solution:<br />
<haskell><br />
problem_5 = head [ x | x <- [2520,5040..], all (\y -> x `mod` y == 0) [1..20]]<br />
</haskell><br />
An alternative solution that takes advantage of the Prelude to avoid use of the generate and test idiom:<br />
<haskell><br />
problem_5' = foldr1 lcm [1..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=6 Problem 6] ==<br />
What is the difference between the sum of the squares and the square of the sums?<br />
<br />
Solution:<br />
<haskell><br />
problem_6 = sum [ x^2 | x <- [1..100]] - (sum [1..100])^2<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=7 Problem 7] ==<br />
Find the 10001st prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_7 = head $ drop 10000 primes<br />
where primes = 2:3:..<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==<br />
Discover the largest product of five consecutive digits in the 1000-digit number.<br />
<br />
Solution:<br />
<haskell><br />
problem_8 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=9 Problem 9] ==<br />
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.<br />
<br />
Solution:<br />
<haskell><br />
problem_9 = head [a*b*c | a <- [1..500], b <- [a..500], let c = 1000-a-b, a^2 + b^2 == c^2]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=10 Problem 10] ==<br />
Calculate the sum of all the primes below one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_10 = sum (takeWhile (< 1000000) primes)<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/1_to_10&diff=12273Euler problems/1 to 102007-03-27T16:35:08Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] */ clarify remark</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] ==<br />
Add all the natural numbers below 1000 that are multiples of 3 or 5.<br />
<br />
Solution:<br />
<haskell><br />
problem_1 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=2 Problem 2] ==<br />
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, x `mod` 2 == 0]<br />
where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] ==<br />
Find the largest prime factor of 317584931803.<br />
<br />
Solution:<br />
<haskell><br />
problem_3 = maximum [ x | x <- [1..round $ sqrt (fromInteger c)], c `mod` x == 0]<br />
where c = 317584931803<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==<br />
Find the largest palindrome made from the product of two 3-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_4 = foldr max 0 [ x | y <- [100..999], z <- [100..999], let x = y * z, let s = show x, s == reverse s]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] ==<br />
What is the smallest number divisible by each of the numbers 1 to 20?<br />
<br />
Solution:<br />
<haskell><br />
problem_5 = head [ x | x <- [2520,5040..], all (\y -> x `mod` y == 0) [1..20]]<br />
</haskell><br />
An alternative solution that takes advantage of the Prelude to avoid use of the generate and test idiom:<br />
<haskell><br />
problem_5' = foldr1 lcm [1..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=6 Problem 6] ==<br />
What is the difference between the sum of the squares and the square of the sums?<br />
<br />
Solution:<br />
<haskell><br />
problem_6 = sum [ x^2 | x <- [1..100]] - (sum [1..100])^2<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=7 Problem 7] ==<br />
Find the 10001st prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_7 = head $ drop 10000 primes<br />
where primes = 2:3:..<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==<br />
Discover the largest product of five consecutive digits in the 1000-digit number.<br />
<br />
Solution:<br />
<haskell><br />
problem_8 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=9 Problem 9] ==<br />
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.<br />
<br />
Solution:<br />
<haskell><br />
problem_9 = head [a*b*c | a <- [1..500], b <- [a..500], let c = 1000-a-b, a^2 + b^2 == c^2]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=10 Problem 10] ==<br />
Calculate the sum of all the primes below one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_10 = sum (takeWhile (< 1000000) primes)<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/1_to_10&diff=12272Euler problems/1 to 102007-03-27T16:33:32Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] */ faster solution</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] ==<br />
Add all the natural numbers below 1000 that are multiples of 3 or 5.<br />
<br />
Solution:<br />
<haskell><br />
problem_1 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=2 Problem 2] ==<br />
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, x `mod` 2 == 0]<br />
where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] ==<br />
Find the largest prime factor of 317584931803.<br />
<br />
Solution:<br />
<haskell><br />
problem_3 = maximum [ x | x <- [1..round $ sqrt (fromInteger c)], c `mod` x == 0]<br />
where c = 317584931803<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==<br />
Find the largest palindrome made from the product of two 3-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_4 = foldr max 0 [ x | y <- [100..999], z <- [100..999], let x = y * z, let s = show x, s == reverse s]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] ==<br />
What is the smallest number divisible by each of the numbers 1 to 20?<br />
<br />
Solution:<br />
<haskell><br />
problem_5 = head [ x | x <- [2520,5040..], all (\y -> x `mod` y == 0) [1..20]]<br />
</haskell><br />
An alternative solution that takes advantage of the Prelude to avoid generate and test:<br />
<haskell><br />
problem_5' = foldr1 lcm [1..20]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=6 Problem 6] ==<br />
What is the difference between the sum of the squares and the square of the sums?<br />
<br />
Solution:<br />
<haskell><br />
problem_6 = sum [ x^2 | x <- [1..100]] - (sum [1..100])^2<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=7 Problem 7] ==<br />
Find the 10001st prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_7 = head $ drop 10000 primes<br />
where primes = 2:3:..<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==<br />
Discover the largest product of five consecutive digits in the 1000-digit number.<br />
<br />
Solution:<br />
<haskell><br />
problem_8 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=9 Problem 9] ==<br />
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.<br />
<br />
Solution:<br />
<haskell><br />
problem_9 = head [a*b*c | a <- [1..500], b <- [a..500], let c = 1000-a-b, a^2 + b^2 == c^2]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=10 Problem 10] ==<br />
Calculate the sum of all the primes below one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_10 = sum (takeWhile (< 1000000) primes)<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Qualehttps://wiki.haskell.org/index.php?title=Euler_problems/1_to_10&diff=12271Euler problems/1 to 102007-03-27T16:27:13Z<p>Quale: /* [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] */ bug fix</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=1 Problem 1] ==<br />
Add all the natural numbers below 1000 that are multiples of 3 or 5.<br />
<br />
Solution:<br />
<haskell><br />
problem_1 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0)]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=2 Problem 2] ==<br />
Find the sum of all the even-valued terms in the Fibonacci sequence which do not exceed one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_2 = sum [ x | x <- takeWhile (<= 1000000) fibs, x `mod` 2 == 0]<br />
where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=3 Problem 3] ==<br />
Find the largest prime factor of 317584931803.<br />
<br />
Solution:<br />
<haskell><br />
problem_3 = maximum [ x | x <- [1..round $ sqrt (fromInteger c)], c `mod` x == 0]<br />
where c = 317584931803<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=4 Problem 4] ==<br />
Find the largest palindrome made from the product of two 3-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
problem_4 = foldr max 0 [ x | y <- [100..999], z <- [100..999], let x = y * z, let s = show x, s == reverse s]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=5 Problem 5] ==<br />
What is the smallest number divisible by each of the numbers 1 to 20?<br />
<br />
Solution:<br />
<haskell><br />
problem_5 = head [ x | x <- [2520,5040..], all (\y -> x `mod` y == 0) [1..20]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=6 Problem 6] ==<br />
What is the difference between the sum of the squares and the square of the sums?<br />
<br />
Solution:<br />
<haskell><br />
problem_6 = sum [ x^2 | x <- [1..100]] - (sum [1..100])^2<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=7 Problem 7] ==<br />
Find the 10001st prime.<br />
<br />
Solution:<br />
<haskell><br />
problem_7 = head $ drop 10000 primes<br />
where primes = 2:3:..<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=8 Problem 8] ==<br />
Discover the largest product of five consecutive digits in the 1000-digit number.<br />
<br />
Solution:<br />
<haskell><br />
problem_8 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=9 Problem 9] ==<br />
There is only one Pythagorean triplet, {''a'', ''b'', ''c''}, for which ''a'' + ''b'' + ''c'' = 1000. Find the product ''abc''.<br />
<br />
Solution:<br />
<haskell><br />
problem_9 = head [a*b*c | a <- [1..500], b <- [a..500], let c = 1000-a-b, a^2 + b^2 == c^2]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=10 Problem 10] ==<br />
Calculate the sum of all the primes below one million.<br />
<br />
Solution:<br />
<haskell><br />
problem_10 = sum (takeWhile (< 1000000) primes)<br />
</haskell><br />
<br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Quale