Euler problems/161 to 170

From HaskellWiki
< Euler problems
Revision as of 13:58, 10 February 2008 by Lisp (talk | contribs)
Jump to navigation Jump to search

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