# Euler problems/141 to 150

The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

## Problem 141

Investigating progressive numbers, n, which are also square.

Solution:

```import Data.List
intSqrt :: Integral a => a -> a
intSqrt n
| n < 0 = error "intSqrt: negative n"
| otherwise = f n
where
f x = if y < x then f y else x
where y = (x + (n `quot` x)) `quot` 2
isSqrt n = n==((^2).intSqrt) n
takec a b =
two++takeWhile (<=e12)
[sq| c1<-[1..], let c=c1*c1,let sq=(c^2*a^3*b+b^2*c) ]
where
e12=10^12
two=[sq|c<-[b,2*b],let sq=(c^2*a^3*b+b^2*c) ]
problem_141=
sum\$nub[c|
(a,b)<-takeWhile (\(a,b)->a^3*b+b^2<e12)
[(a,b)|
a<-[2..e4],
b<-[1..(a-1)]
],
gcd a b==1,
c<-takec a b,
isSqrt c
]
where
e4=120
e12=10^12
```

## Problem 142

Perfect Square Collection

Solution:

```import List
isSquare n = (round . sqrt \$ fromIntegral n) ^ 2 == n
aToX (a,b,c)=[x,y,z]
where
x=(a+b)`div`2
y=(a-b)`div`2
z=c-x
{-
-                                2    2    2
-                               a  = c  + d
-                                2    2    2
-                               a  = e  + f
-                                2    2    2
-                               c  = e  + b
-   let b=x*y  then
-                                             (y + xb)
-                                          c= ---------
-                                                 2
-                                             (-y + xb)
-                                          e= ---------
-                                                 2
-                                             (-x + yb)
-                                          d= ---------
-                                                 2
-                                             (x + yb)
-                                          f= ---------
-                                                 2
-
- and
-                                2    2    2
-                               a  = c  + d
- then
-                                   2    2    2  2
-                              2  (y  + x ) (x  y  + 1)
-                             a = ---------------------
-                                           4
-
-}
problem_142 = sum\$head[aToX(t,t2 ,t3)|
a<-[3,5..50],
b<-[(a+2),(a+4)..50],
let a2=a^2,
let b2=b^2,
let n=(a2+b2)*(a2*b2+1),
isSquare n,
let t=n`div`4,
let t2=a2*b2,
let t3=(a2*(b2+1)^2)`div`4
]
```

## Problem 143

Investigating the Torricelli point of a triangle

## Problem 144

Investigating multiple reflections of a laser beam.

Solution:

```type Point = (Double, Double)
type Vector = (Double, Double)
type Normal = (Double, Double)

sub :: Vector -> Vector -> Vector
sub (x,y) (a,b) = (x-a, y-b)

mull :: Double -> Vector -> Vector
mull s (x,y) = (s*x, s*y)

mulr :: Vector -> Double -> Vector
mulr v s = mull s v

dot :: Vector -> Vector -> Double
dot (x,y) (a,b) = x*a + y*b

normSq :: Vector -> Double
normSq v = dot v v

normalize :: Vector -> Vector
normalize v
|len /= 0 =mulr v (1.0/len)
|otherwise=error "Vettore nullo.\n"
where
len = (sqrt . normSq) v

proj :: Vector -> Vector -> Vector
proj a b = mull ((dot a b)/normSq b) b

reflect :: Vector -> Normal -> Vector
reflect i n = sub i \$ mulr (proj i n) 2.0

type Ray = (Point, Vector)

makeRay :: Point -> Vector -> Ray
makeRay p v = (p, v)

getPoint :: Ray -> Double -> Point
getPoint ((px,py),(vx,vy)) t = (px + t*vx, py + t*vy)

type Ellipse = (Double, Double)

getNormal :: Ellipse -> Point -> Normal
getNormal (a,b) (x,y) = ((-b/a)*x, (-a/b)*y)

rayFromPoint :: Ellipse -> Vector -> Point -> Ray
rayFromPoint e v p = makeRay p (reflect v (getNormal e p))

test :: Point -> Bool
test (x,y) = y > 0 && x >= -0.01 && x <= 0.01

intersect :: Ellipse -> Ray -> Point
intersect (e@(a,b)) (r@((px,py),(vx,vy))) =
getPoint r t1
where
c0 = normSq (vx/a, vy/b)
c1 = 2.0 * dot (vx/a, vy/b) (px/a, py/b)
c2 = (normSq (px/a, py/b)) - 1.0
(t0, t1) = quadratic c0 c1 c2

quadratic :: Double -> Double -> Double -> (Double, Double)
quadratic a b c
|d < 0= error "Discriminante minore di zero"
|otherwise= if (t0 < t1) then (t0, t1) else (t1, t0)
where
d = b * b - 4.0 * a * c
sqrtD = sqrt d
q = if b < 0 then -0.5*(b - sqrtD) else 0.5*(b + sqrtD)
t0 = q / a
t1 = c / q

calculate :: Ellipse -> Ray -> Int -> IO ()
calculate e (r@(o,d)) n
|test p=print n
|otherwise=do
putStrLn \$ "\rHit " ++ show n
calculate e (rayFromPoint e d p) (n+1)
where
p = intersect e r

origin = (0.0,10.1)
direction = sub (1.4,-9.6) origin
ellipse = (5.0,10.0)

problem_144 = do
calculate ellipse (makeRay origin direction) 0
```

## Problem 145

How many reversible numbers are there below one-billion?

Solution:

```import List

digits n
{-  123->[3,2,1]
-}
|n<10=[n]
|otherwise= y:digits x
where
(x,y)=divMod n 10
-- 123 ->321
dmm=(\x y->x*10+y)
palind n=foldl dmm 0 (digits n)

isOdd x=(length\$takeWhile odd x)==(length x)
isOdig x=isOdd m && s<=h
where
k=x+palind x
m=digits k
y=floor\$logBase 10 \$fromInteger x
ten=10^y
s=x`mod`10
h=x`div`ten

a2=[i|i<-[10..99],isOdig i]
aa2=[i|i<-[10..99],isOdig i,mod i 10/=0]
a3=[i|i<-[100..999],isOdig i]
m5=[i|i1<-[0..99],i2<-[0..99],
let i3=i1*1000+3*100+i2,
let i=10^6*   8+i3*10+5,
isOdig i
]

fun i
|i==2  =2*le aa2
|even i=(fun 2)*d^(m-1)
|i==3  =2*le a3
|i==7  =fun 3*le m5
|otherwise=0
where
le=length
m=div i 2
d=2*le a2

problem_145 = sum[fun a|a<-[1..9]]
```

## Problem 146

Investigating a Prime Pattern

Solution:

```import List
isPrime x=millerRabinPrimality x 2
--isPrime x=all (millerRabinPrimality x) [2,3,7,61,24251]
six=[1,3,7,9,13,27]
allPrime x=all (\a -> isPrime (x^2+a)) six
b<-[0..(x-1)],
let y=b*prxs+a,
let c=y`mod`x,
elem c d]
where
prxs=product xs
d=filterPrime x

filterPrime p=
[a|
a<-[0..(p-1)],
length[b|b<-six,(a^2+b)`mod`p/=0]==6
]
testPrimes=[2,3,5,7,11,13,17,23]
primes=[2,3,5,7,11,13,17,23,29]
test =
sum[y|
y<1000000,
allPrime (y)
]==1242490
p146 =[y|y<-linkPrime primes,y<150000000,allPrime y]
problem_146=[a|a<-p146, allNext a]
allNext x=
sum [1|(x,y)<-zip a b,x==y]==6
where
a=[x^2+b|b<-six]
b=head a:map nextPrime a
nextPrime x=head [a|a<-[(x+1)..],isPrime a]
main=writeFile "p146.log" \$show \$sum problem_146
```

## Problem 147

Rectangles in cross-hatched grids

## Problem 148

Exploring Pascal's triangle.

Solution:

```triangel 0 = 0
triangel n
|n <7 =n+triangel (n-1)
|n==k7 =28^k
|otherwise=(triangel i) + j*(triangel (n-i))
where
i=k7*((n-1)`div`k7)
j= -(n`div`(-k7))
k7=7^k
k=floor . logBase 7 . fromIntegral \$ n
problem_148=triangel (10^9)
```

## Problem 149

Searching for a maximum-sum subsequence.

Solution:

```import Data.Array
import Data.List (foldl')

n = 2000

res = maximum' \$ concat [rows, cols, diags, diags']
where
rows   = map (maxSumInRow . getRow   laggedFibArray) [0 .. n-1]
cols   = map (maxSumInRow . getCol   laggedFibArray) [0 .. n-1]
diags  = map (maxSumInRow . getDiag  laggedFibArray) [-(n-2) .. (n-2)]
diags' = map (maxSumInRow . getDiag' laggedFibArray) [-(n-2) .. (n-2)]

laggedFibArray :: Array Integer Integer
laggedFibArray = listArray (0, n^2-1) \$ map f [1..n^2]
where
f k = norm \$ if k < 56
then 100003 - (200003*k) + (300007*(k^3))
else (laggedFibArray ! (k-25)) + (laggedFibArray ! (k-56)) + (10^6)

norm x = mod x (10^6) - 500000

getRow   a i = map (a!) [i*n .. (i+1)*n-1]
getCol   a i = map (a!) [i,n+i .. n*(n-1)+i]
getDiag  a i = map (a!) \$
if i >= 0
then [(i*n) + (k*(n+1)) | k <- [0..n-i-1]]
else [k + n*(k+i) | k <- [-i .. n-1]]
getDiag' a i = map (a!) \$
if i >= 0
then [(n*k) + n-k-i-1 | k <- [0..n-i-1]]
else [n*(k-i) + n-k-1 | k <- [0..n+i-1]]

maxSumInRow = snd . foldl' f (0,0)
where
f (line_sum, line_max) x = (line_sum', max line_max line_sum')
where line_sum' = max (line_sum+x) 0

-- strict version of maximum
maximum' (x:xs) = foldl' max x xs

main = print res
```

## Problem 150

Searching a triangular array for a sub-triangle having minimum-sum.