Euler problems/161 to 170
From HaskellWiki
Contents
Problem 161
Triominoes
Solution:
#include <stdio.h>
#include <stdlib.h>
int x[3][9]={{0,0,0,0,0,0,0,-1,0},
{0,0,0,1,0,0,1,0,0},
{0,0,0,2,1,1,1,0,0}};
int y[3][9]={{0,0,0,0,0,0,0,1,0},
{0,1,1,0,1,1,0,0,0},
{0,0,2,0,1,0,1,1,0}};
int num[9]={1,2,3,3,3,3,3,3,0};
int M[16][4],A[16],rem3;
void printint64(long long int n)
{
int i,len,digit[20];
if(n<0) printf("-"),n=-n;
digit[0]=n%10,n/=10,len=1;
while(n) digit[len]=n%10,n/=10,len++;
for(i=len-1;i>=0;i--) printf("%d",digit[i]);
return;
}
void re(int pos) {
int j,c=A[pos];
for(j=0;j<num[c];j++) M[pos+x[j][c]][y[j][c]]--;
rem3-=num[c];
return;
}
int main() {
int c,i,j,k,n,w1,w2,T,pos,pow3[9];
int *u,*w,var=0;
u=(int*) (malloc) (131072*sizeof(int));
w=(int*) (malloc) (131072*sizeof(int));
pow3[0]=1;
for(i=1;i<9;i++) pow3[i]=3*pow3[i-1];
long long int p[19683],q[19683];
p[0]=1;
for(i=1;i<19683;i++) p[i]=0;
for(i=0;i<19683;i++) q[i]=0;
pos=0;
A[0]=0;
rem3=0;
for(j=0;j<11;j++)
for(k=0;k<3;k++) M[j][k]=0;
while(A[0]<7) {
if(M[pos][0]) A[pos]=8,pos++,A[pos]=0;
else {
c=A[pos];
rem3+=num[c];
if((pos<8)||(rem3%3==0)) {
T=1;
for(j=0;j<num[c];j++) {
M[pos+x[j][c]][y[j][c]]++;
if(M[pos+x[j][c]][y[j][c]]>1) T=0;
}
if((T==0)||M[9][0]||M[9][1]) {
re(pos);
while(A[pos]>=7) pos--,re(pos);
A[pos]++;
}
else pos++,A[pos]=0;
}
else {
rem3-=num[c];
while(A[pos]>=7) pos--,re(pos);
A[pos]++;
}
}
if(pos==9) {
w1=0;
for(j=0;j<9;j++) {
if(A[j]==0) w1+=pow3[j];
else if(A[j]==1) w1+=2*pow3[j];
}
w2=0;
for(j=0;j<9;j++) {
c=0;
if(M[j][1]) c=1;
if(M[j][2]) c=2;
w2+=c*pow3[j];
}
u[var]=w2;
w[var]=w1;
var++;
pos--,re(pos);
while(A[pos]>=7) pos--,re(pos);
A[pos]++;
}
}
for(n=1;n<=12;n++) {
if(n%2) {
for(i=0;i<var;i++) q[u[i]]+=p[w[i]];
for(i=0;i<19683;i++) p[i]=0;
printf("tiling[9][%d]=",n),printint64(q[0]),printf("\n");
}
else {
for(i=0;i<var;i++) p[u[i]]+=q[w[i]];
for(i=0;i<19683;i++) q[i]=0;
printf("tiling[9][%d]=",n),printint64(p[0]),printf("\n");
}
}
return 1;
}
problem_161 = main
Problem 162
Hexadecimal numbers
Solution:
numdigit=['0'..'9']++['A'..'F']
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 ((numdigit!!).fromInteger) $reverse $digits fsum
Problem 163
Cross-hatched triangles
Solution:
--http://www.math.uni-bielefeld.de/~sillke/SEQUENCES/grid-triangles
fun n=
sum[div (2*n3 + 5*n2 + 2*n) 8 ,
2*(div n3 2- div n 6) ,
6* sum[div ( n*(n+1)*(n+2)) 6 ,
div (2*n3 + 5*n2 + 2*n) 8 ,
div (2*n3 + 3*n2 - 3*n) 18 ,
div (2*n3 + 3*n2 - 3*n) 10 ],
3 * div(22*n3 + 45*n2 - 4*n) 48
]
where
n3=n*n*n
n2=n*n
problem_163=fun 36
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]]
Problem 165
Intersections
Solution:
bbsGen x = (x * x) `mod` 50515093
bbsSeq = iterate bbsGen 290797
tValues = map (`mod` 500) (tail bbsSeq)
lineSeg n = take 4 (drop n tValues)
lineSegs' n = lineSeg n : lineSegs' (n + 4)
lineSegs = lineSegs' 0
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 [] = []
listIntersects l (l1:ls) | b = [(x,y)] ++ (listIntersects l ls)
| otherwise = listIntersects l ls
where (b, x, y) = intersect l l1
allIntersectsList [] = []
allIntersectsList (l:ls) = listIntersects l ls ++ allIntersectsList ls
problem_165 = length . quickSort . allIntersectsList $ take 5000 lineSegs
quickSort :: Ord a => [(a,a)] -> [(a,a)]
quickSort [] = []
quickSort (l:ls) = quickSort (filter (< l) ls) ++
[l] ++
quickSort (filter (> l) ls)
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
Problem 167
Investigating Ulam sequences
Solution:
problem_167 = undefined
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=flip mod (10^5)$sum[fun e|i<-[1..99],let e=10^i]
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' $div n 2
fusc =fst.fusc'
problem_169=fusc (10^25)
Problem 170
Find the largest 0 to 9 pandigital that can be formed by concatenating products.
Solution:
problem_170 = undefined