# Euler problems/141 to 150

(Difference between revisions)

## 1 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```

## 2 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=div (a+b) 2
y=div (a-b) 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
-
-}
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=div n 4,
let t2=a2*b2,
let t3=div (a2*(b2+1)^2) 4
]```

## 3 Problem 143

Investigating the Torricelli point of a triangle

Solution:

```import Data.List
import Data.Array.ST
import Data.Array
import qualified Data.Array.Unboxed as U

mkCan :: [Int] -> [(Int,Int)]
mkCan lst = map func \$ group \$ insert 3 lst
where
func ps@(p:_)
| p == 3    = (3,2*l-1)
| otherwise = (p, 2*l)
where
l = length ps

spfArray :: U.UArray Int Int
spfArray
= runSTUArray
(do ar <- newArray (2,13397) 0
let loop k
| k > 13397 = return ()
| otherwise = do writeArray ar k 2
loop (k+2)
loop 2
let go i
| i > 13397 = return ar
| otherwise
= do p <- readArray ar i
if (p == 0)
then do writeArray ar i i
let run k
| k > 13397 = go (i+2)
| otherwise
= do q <- readArray ar k
when (q == 0)
(writeArray ar k i)
run (k+2*i)
run (i*i)
else go (i+2)
go 3)

factArray :: Array Int [Int]
factArray
= runSTArray
(do ar <- newArray (1,13397) []
let go i
| i > 13397 = return ar
| otherwise = do let p = spfArray U.! i
q = i `div` p
writeArray ar i (p:fs)
go (i+1)
go 2)

sdivs :: Int -> [(Int,Int)]
sdivs s
= filter ((<= 100000) . uncurry (+)) \$ zip sds' lds'
where
bd = 3*s*s
pks = mkCan \$ factArray ! s
fun (p,k) = take (k+1) \$ iterate (*p) 1
ds = map fun pks
(sds,lds) = span ((< bd) . (^2)) . sort \$ foldr (liftM2 (*)) [1] ds
sds' = map (+ 2*s) sds
lds' = reverse \$ map (+ 2*s) lds

pairArray :: Array Int [Int]
pairArray
= runSTArray
(do ar <- newArray (3,50000) []
let go s
| s > 13397 = return ar
| otherwise
= do let run [] = go (s+1)
run ((r,q):ds)
= do lst <- readArray ar r
let nlst = insert q lst
writeArray ar r nlst
run ds
run \$ sdivs s
go 1)

select2 :: [Int] -> [(Int,Int)]
select2 []     = []
select2 (a:bs) = [(a,b) | b <- bs] ++ select2 bs

sumArray :: U.UArray Int Bool
sumArray
= runSTUArray
(do ar <- newArray (12,100000) False
let go r
| r > 33332 = return ar
| otherwise
= do let run [] = go (r+1)
run ((q,p):xs)
= do when (p `elem` (pairArray!q))
(writeArray ar (p+q+r) True)
run xs
run \$ filter ((<= 100000) . (+r) . uncurry (+)) \$
select2 \$ pairArray!r
go 3)

main :: IO ()
main = writeFile "p143.log"\$show\$ sum [s | (s,True) <- U.assocs sumArray]
problem_143 = main```

## 4 Problem 144

Investigating multiple reflections of a laser beam.

Solution:

`problem_144 = undefined`

## 5 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=mod x 10
h=div x 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]]```

## 6 Problem 146

Investigating a Prime Pattern

Solution:

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

filterPrime p=
[a|
a<-[0..(p-1)],
length[b|b<-six,mod (a^2+b) 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
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]
main=writeFile "p146.log" \$show \$sum problem_146```

## 7 Problem 147

Rectangles in cross-hatched grids

Solution:

`problem_147 = undefined`

## 8 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(log (fromIntegral n)/log 7)
problem_148=triangel (10^9)```

## 9 Problem 149

Searching for a maximum-sum subsequence.

Solution:

```#include<stdio.h>
#define N 2000
#define   max(a,b)   ((a)   >   (b)   ?   (a)   :   (b))
int s[4000001];
int MaxSubsequenceSum(int s[] , int n) {
int j;
int ThisSum, MaxSum ;
ThisSum = MaxSum = 0;
for ( j=0; j<n ; j++)
{
ThisSum += s[j];
if (ThisSum> MaxSum)
MaxSum = ThisSum;
else if (ThisSum < 0)
ThisSum = 0;
}
return MaxSum;
}
long long Generate(int ind){
long long k = ind;
if (ind <= 55)
return  ((100003 - 200003*k + 300007*k*k*k) % 1000000) - 500000;
return (s[k-24]+s[k-55]+1000000)%1000000-500000;

}
int main()
{
int sums=0;
int maxx=0;
for (int i=1;i<4000001;i++){
s[i]=(int)(Generate(i));
}
printf("%d  %d \n",s[10],s[100]);
int ks[N],kss[N];
for (int k=0;k<N;k++){
for(int b=0;b<N;b++)
{
ks[b]=s[k*N+b+1];
kss[b]=s[b*N+k+1];
}
sums=MaxSubsequenceSum(ks,N);
sums=max(sums,MaxSubsequenceSum(kss,N));
maxx=max (maxx,sums);
}
int ksi,ksj, x,y,y1;
for (int k=-N+1;k<N;k++){
ksi=ksj=0;
for(int b=0;b<N;b++)
{
x=k+b;
y=b;
y1=N-1-b;
if (x>-1 && x<N && y>-1 && y<N)
ks[ksi++]=s[x*N+y+1];
if (x>-1 && x<N && y1>-1 && y1<N)
kss[ksj++]=s[x*N+y1+1];
}
sums=MaxSubsequenceSum(ks,ksi);
sums=max(sums,MaxSubsequenceSum(kss,ksj));
maxx=max (maxx,sums);
}
printf("%d\n",maxx);
}
problem_149 = main```

## 10 Problem 150

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

Solution:

`problem_150 = undefined`