Personal tools

Euler problems/161 to 170

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(added problem_165)
Line 4: Line 4:
Solution:
Solution:
<haskell>
<haskell>
-
problem_161 = undefined
+
#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
</haskell>
</haskell>
Line 12: Line 131:
Solution:
Solution:
<haskell>
<haskell>
-
problem_162 = undefined
+
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
</haskell>
</haskell>
Line 139: Line 267:
Solution:
Solution:
<haskell>
<haskell>
-
problem_168 = undefined
+
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]
</haskell>
</haskell>

Revision as of 07:35, 10 February 2008

Contents

1 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

2 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

3 Problem 163

Cross-hatched triangles

Solution: 

problem_163 = undefined

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]]

5 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)

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

7 Problem 167

Investigating Ulam sequences

Solution: 

problem_167 = undefined

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=flip mod (10^5)$sum[fun e|i<-[1..99],let e=10^i]

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' $div n 2
fusc =fst.fusc'
problem_169=fusc (10^25)

10 Problem 170

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

Solution: 

problem_170 = undefined
Retrieved from "http://www.haskell.org/haskellwiki/Euler_problems/161_to_170"