Personal tools

Euler problems/161 to 170

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(Added problem_164)
m
 
(18 intermediate revisions by 8 users not shown)
Line 1: Line 1:
== [http://projecteuler.net/index.php?section=view&id=161 Problem 161] ==
+
== [http://projecteuler.net/index.php?section=problems&id=161 Problem 161] ==
 
Triominoes
 
Triominoes
   
Solution:
+
{{sect-stub}}
<haskell>
 
problem_161 = undefined
 
</haskell>
 
   
== [http://projecteuler.net/index.php?section=view&id=162 Problem 162] ==
+
== [http://projecteuler.net/index.php?section=problems&id=162 Problem 162] ==
 
Hexadecimal numbers
 
Hexadecimal numbers
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_162 = undefined
+
import Data.Char (intToDigit)
  +
digits n
  +
|n<16=[n]
  +
|otherwise= y:digits x
  +
where
  +
(x,y)=divMod n 16
  +
fun k=15*16^(k-1)-15^(k)-2*14*15^(k-1)+13*14^(k-1)+2*14^k-13^k
  +
fsum::Integer
  +
fsum=sum $map fun [3..16]
  +
problem_162=map (intToDigit.fromInteger) $reverse $digits fsum
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=163 Problem 163] ==
+
== [http://projecteuler.net/index.php?section=problems&id=163 Problem 163] ==
 
Cross-hatched triangles
 
Cross-hatched triangles
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_163 = undefined
+
--http://www.math.uni-bielefeld.de/~sillke/SEQUENCES/grid-triangles
  +
fun n=
  +
sum[(2*n3 + 5*n2 + 2*n) `div` 8 ,
  +
2*(n3 `div` 2- n `div` 6) ,
  +
6* sum[( n*(n+1)*(n+2)) `div` 6 ,
  +
(2*n3 + 5*n2 + 2*n) `div` 8 ,
  +
(2*n3 + 3*n2 - 3*n) `div` 18 ,
  +
(2*n3 + 3*n2 - 3*n) `div` 10 ],
  +
3 * ((22*n3 + 45*n2 - 4*n) `div` 48)
  +
]
  +
where
  +
n3=n^3
  +
n2=n^2
  +
problem_163=fun 36
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=164 Problem 164] ==
+
== [http://projecteuler.net/index.php?section=problems&id=164 Problem 164] ==
 
Numbers for which no three consecutive digits have a sum greater than a given value.
 
Numbers for which no three consecutive digits have a sum greater than a given value.
   
Line 31: Line 31:
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=165 Problem 165] ==
+
== [http://projecteuler.net/index.php?section=problems&id=165 Problem 165] ==
 
Intersections
 
Intersections
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_165 = undefined
+
import Data.List (nub)
  +
  +
bbsGen x = (x * x) `mod` 50515093
  +
  +
bbsSeq = iterate bbsGen 290797
  +
  +
tValues = map (`mod` 500) (tail bbsSeq)
  +
  +
lineSeg n = take 4 (drop n tValues)
  +
  +
lineSegs = map lineSeg [0,4..]
  +
  +
implicitLine :: [Integer] -> (Integer, Integer, Integer)
  +
implicitLine [x1,y1,x2,y2] = (a, b, d) where
  +
a = y2 - y1
  +
b = -(x2 - x1)
  +
d = x1*a + y1 * b
  +
  +
within :: (Ord a, Num a, Integral b) => a -> b -> b -> Bool
  +
within a b c | b > c = within a c b
  +
| otherwise = a >= fromIntegral b && a <= fromIntegral c
  +
  +
withinSeg :: (Ord a, Num a) => a -> a -> [Integer] -> Bool
  +
withinSeg x y l@[x1,y1,x2,y2] = within x x1 x2 && within y y1 y2 && not (endpoint x y l)
  +
  +
endpoint :: (Ord a, Num a) => a -> a -> [Integer] -> Bool
  +
endpoint x y [x1,y1,x2,y2] = ((x == fromIntegral x1) && (y == fromIntegral y1)) ||
  +
((x == fromIntegral x2) && (y == fromIntegral y2))
  +
  +
boundingBoxOverlap l1@[l1x1,l1y1,l1x2,l1y2] l2@[l2x1,l2y1,l2x2,l2y2]
  +
| min l1x1 l1x2 > max l2x1 l2x2 = False
  +
| max l1x1 l1x2 < min l2x1 l2x2 = False
  +
| min l1y1 l1y2 > max l2y1 l2y2 = False
  +
| max l1y1 l1y2 < min l2y1 l2y2 = False
  +
| otherwise = True
  +
  +
intersect :: (Fractional a, Ord a) => [Integer] -> [Integer] -> (Bool, a, a)
  +
intersect l1 l2 | boundingBoxOverlap l1 l2 &&
  +
d /= 0 &&
  +
withinSeg x y l1 && withinSeg x y l2 = (True, x, y)
  +
| otherwise = (False, 0, 0)
  +
where
  +
(a1, b1, d1) = implicitLine l1
  +
(a2, b2, d2) = implicitLine l2
  +
d = fromIntegral (a1*b2 - a2*b1)
  +
x = fromIntegral (b2 * d1 - b1 * d2) / d
  +
y = fromIntegral (a1 * d2 - a2 * d1) / d
  +
  +
listIntersects l ls = [(x,y) | l1 <- ls, let (b, x, y) = intersect l l1, b]
  +
  +
allIntersectsList [] = []
  +
allIntersectsList (l:ls) = listIntersects l ls ++ allIntersectsList ls
  +
  +
problem_165 = length . nub . allIntersectsList $ take 5000 lineSegs
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=166 Problem 166] ==
+
== [http://projecteuler.net/index.php?section=problems&id=166 Problem 166] ==
 
Criss Cross
 
Criss Cross
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_166 = undefined
+
problem_166 =
  +
sum [ product (map count [[0, c, b-d, a-b-d],
  +
[0, b-a, c+d-a, b+d-a],
  +
[0, -b-c, a-b-c-d, -c-d],
  +
[0, a, d, c+d]])|
  +
a <- [-9..9],
  +
b <- [-9+a..9+a],
  +
c <- [-9..9],
  +
d <- [-9+a-c..9+a-c]]
  +
where
  +
count xs
  +
|u<l=0
  +
|otherwise=u-l+1
  +
where
  +
l = -minimum xs
  +
u = 9-maximum xs
 
</haskell>
 
</haskell>
   
== [http://projecteuler.net/index.php?section=view&id=167 Problem 167] ==
+
== [http://projecteuler.net/index.php?section=problems&id=167 Problem 167] ==
 
Investigating Ulam sequences
 
Investigating Ulam sequences
  +
  +
{{sect-stub}}
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=168 Problem 168] ==
  +
Number Rotations
  +
  +
Solution:
  +
<haskell>
  +
fun e =
  +
sum[n*10+d|
  +
let t=[1..9],
  +
d<-t,
  +
p<-t,
  +
let (n,m)=divMod ((e-p)*d) (10*p-1) ,
  +
m==0,
  +
10*n>=e
  +
]
  +
problem_168=(`mod`(10^5))$sum[fun e|i<-[1..99],let e=10^i]
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=169 Problem 169] ==
  +
Exploring the number of different ways a number can be expressed as a sum of powers of 2.
  +
  +
Solution:
  +
<haskell>
  +
fusc' 0=(1,0)
  +
fusc' n
  +
|even n=(a+b, b)
  +
|odd n=(a,a+b)
  +
where
  +
(a,b)=fusc' $n`div`2
  +
fusc =fst.fusc'
  +
problem_169=fusc (10^25)
  +
</haskell>
  +
  +
== [http://projecteuler.net/index.php?section=problems&id=170 Problem 170] ==
  +
Find the largest 0 to 9 pandigital that can be formed by concatenating products.
   
 
Solution:
 
Solution:
 
<haskell>
 
<haskell>
problem_167 = undefined
+
{-
  +
1) The first integer must be a multiple of 3
  +
(otherwise the digital root of the result is not 9).
  +
2) The first integer contains at most 2 digits
  +
(otherwise the result contains more than 10 digits).
  +
3) The first integer must be less than 49
  +
(otherwise the result contains more than 10 digits).
  +
4) maybe answer is 98xxxx
  +
5) This number must be a multiple of the first factor (f).
  +
In the numbers f and cp/f all digits 1..9 have to occour
  +
once and at least one zeros.
  +
-}
  +
import Data.List
  +
permutationsOf [] = [[]]
  +
permutationsOf xs = [x:xs' | x <- xs, xs' <- permutationsOf (delete x xs)]
  +
digits =reverse.digits'
  +
where
  +
digits' n
  +
|n<10=[n]
  +
|otherwise= y:digits' x
  +
where
  +
(x,y)=divMod n 10
  +
digitsToNum n=foldl dmm 0 n
  +
where
  +
dmm x y=x*10+y
  +
fun k xs c=or [n/=0 && n<100|a<-k,let n=c*xs!!(a+1)]
  +
problem_170 =
  +
maximum[b|
  +
aa<-[7,6..4],
  +
a<-permutationsOf $delete aa [0..7],
  +
let b=digitsToNum $[9,8]++(aa:a),
  +
c<-[12,15..48],
  +
let (d,m)=divMod b c ,
  +
m==0,
  +
let xs=digits d,
  +
(digits c++xs) \\t==[0],
  +
let k=elemIndices 0 xs,
  +
last xs/=0,
  +
fun k xs c
  +
]
  +
where
  +
t=[0..9]
 
</haskell>
 
</haskell>

Latest revision as of 06:18, 15 December 2009

Contents

[edit] 1 Problem 161

Triominoes

[edit] 2 Problem 162

Hexadecimal numbers

Solution:

import Data.Char (intToDigit)
digits n
    |n<16=[n]
    |otherwise= y:digits x 
    where
    (x,y)=divMod n 16
fun k=15*16^(k-1)-15^(k)-2*14*15^(k-1)+13*14^(k-1)+2*14^k-13^k
fsum::Integer
fsum=sum $map fun [3..16]
problem_162=map (intToDigit.fromInteger) $reverse $digits fsum

[edit] 3 Problem 163

Cross-hatched triangles

Solution:

--http://www.math.uni-bielefeld.de/~sillke/SEQUENCES/grid-triangles
fun n= 
    sum[(2*n3 + 5*n2 + 2*n) `div` 8  ,
    2*(n3 `div` 2- n `div` 6)  , 
    6* sum[( n*(n+1)*(n+2)) `div` 6 ,
        (2*n3 + 5*n2 + 2*n) `div` 8 ,
        (2*n3 + 3*n2 - 3*n) `div` 18 ,
        (2*n3 + 3*n2 - 3*n) `div` 10 ],
    3 * ((22*n3 + 45*n2 - 4*n) `div` 48)
    ]
    where
    n3=n^3
    n2=n^2
problem_163=fun 36

[edit] 4 Problem 164

Numbers for which no three consecutive digits have a sum greater than a given value.

Solution:

addDigit x = [[sum [x !! b !! c | c <- [0..9-a-b]] | b <- [0..9-a]] | a<-[0..9]]
x3 = [[10-a-b | b <- [0..9-a]] | a <- [0..9]]
x20 = iterate addDigit x3 !! 17
problem_164 = sum [x20 !! a !! b | a <- [1..9], b <- [0..9-a]]

[edit] 5 Problem 165

Intersections

Solution:

import Data.List (nub)
 
bbsGen x = (x * x) `mod` 50515093
 
bbsSeq = iterate bbsGen 290797
 
tValues = map (`mod` 500) (tail bbsSeq)
 
lineSeg n = take 4 (drop n tValues)
 
lineSegs = map lineSeg [0,4..]
 
implicitLine :: [Integer] -> (Integer, Integer, Integer)
implicitLine [x1,y1,x2,y2] = (a, b, d) where
	a = y2 - y1
	b = -(x2 - x1)
	d = x1*a + y1 * b
 
within :: (Ord a, Num a, Integral b) => a -> b -> b -> Bool
within a b c | b > c = within a c b
			 | otherwise = a >= fromIntegral b && a <= fromIntegral c
 
withinSeg :: (Ord a, Num a) => a -> a -> [Integer] -> Bool
withinSeg x y l@[x1,y1,x2,y2] = within x x1 x2 && within y y1 y2 && not (endpoint x y l)
 
endpoint :: (Ord a, Num a) => a -> a -> [Integer] -> Bool
endpoint x y [x1,y1,x2,y2] = ((x == fromIntegral x1) && (y == fromIntegral y1)) ||
                             ((x == fromIntegral x2) && (y == fromIntegral y2))
 
boundingBoxOverlap l1@[l1x1,l1y1,l1x2,l1y2] l2@[l2x1,l2y1,l2x2,l2y2]
				| min l1x1 l1x2 > max l2x1 l2x2 = False
				| max l1x1 l1x2 < min l2x1 l2x2 = False
				| min l1y1 l1y2 > max l2y1 l2y2 = False
				| max l1y1 l1y2 < min l2y1 l2y2 = False
				| otherwise = True
 
intersect :: (Fractional a, Ord a) => [Integer] -> [Integer] -> (Bool, a, a)
intersect l1 l2 | boundingBoxOverlap l1 l2 && 
                  d /= 0 && 
                  withinSeg x y l1 && withinSeg x y l2 = (True, x, y)
				| otherwise = (False, 0, 0)
	where
		(a1, b1, d1) = implicitLine l1
		(a2, b2, d2) = implicitLine l2
		d = fromIntegral (a1*b2 - a2*b1)
		x = fromIntegral (b2 * d1 - b1 * d2) / d
		y = fromIntegral (a1 * d2 - a2 * d1) / d
 
listIntersects l ls = [(x,y) | l1 <- ls, let (b, x, y) = intersect l l1, b]
 
allIntersectsList [] = []
allIntersectsList (l:ls) = listIntersects l ls ++ allIntersectsList ls
 
problem_165 = length . nub . allIntersectsList $ take 5000 lineSegs

[edit] 6 Problem 166

Criss Cross

Solution:

problem_166 = 
    sum [ product (map count [[0, c, b-d, a-b-d], 
            [0, b-a, c+d-a, b+d-a], 
            [0, -b-c, a-b-c-d, -c-d],
            [0, a, d, c+d]])|
        a <- [-9..9], 
        b <- [-9+a..9+a],
        c <- [-9..9],
        d <- [-9+a-c..9+a-c]]
    where
    count xs 
        |u<l=0 
        |otherwise=u-l+1
        where
        l = -minimum xs 
        u = 9-maximum xs

[edit] 7 Problem 167

Investigating Ulam sequences

[edit] 8 Problem 168

Number Rotations

Solution:

fun e =
    sum[n*10+d|
    let t=[1..9],
    d<-t,
    p<-t,
    let (n,m)=divMod ((e-p)*d) (10*p-1) ,
    m==0,
    10*n>=e
    ]
problem_168=(`mod`(10^5))$sum[fun e|i<-[1..99],let e=10^i]

[edit] 9 Problem 169

Exploring the number of different ways a number can be expressed as a sum of powers of 2.

Solution:

fusc' 0=(1,0)
fusc' n
    |even n=(a+b, b)
    |odd n=(a,a+b)
    where
    (a,b)=fusc' $n`div`2
fusc =fst.fusc'
problem_169=fusc (10^25)

[edit] 10 Problem 170

Find the largest 0 to 9 pandigital that can be formed by concatenating products.

Solution:

{-
1) The first integer must be a multiple of 3 
(otherwise the digital root of the result is not 9).
2) The first integer contains at most 2 digits 
(otherwise the result contains more than 10 digits).
3) The first integer must be less than 49 
(otherwise the result contains more than 10 digits). 
4) maybe answer is 98xxxx
5) This number must be a multiple of the first factor (f).
In the numbers f and cp/f all digits 1..9 have to occour 
once and at least one zeros. 
 -}
import Data.List 
permutationsOf [] = [[]]
permutationsOf xs = [x:xs' | x <- xs, xs' <- permutationsOf (delete x xs)]
digits =reverse.digits' 
    where
    digits' n 
        |n<10=[n]
        |otherwise= y:digits' x 
        where
        (x,y)=divMod n 10
digitsToNum n=foldl dmm 0  n
    where
    dmm x y=x*10+y
fun k xs c=or [n/=0 && n<100|a<-k,let n=c*xs!!(a+1)]
problem_170 =
    maximum[b|
    aa<-[7,6..4],
    a<-permutationsOf $delete aa [0..7],
    let b=digitsToNum $[9,8]++(aa:a),
    c<-[12,15..48],
    let (d,m)=divMod b c ,
    m==0,
    let xs=digits d,
    (digits c++xs) \\t==[0],
    let k=elemIndices 0 xs,
    last xs/=0,
    fun k xs c
    ]
    where
    t=[0..9]