Personal tools

Euler problems/171 to 180

From HaskellWiki

< Euler problems(Difference between revisions)
Jump to: navigation, search
(rm copyvio)
Line 88: Line 88:
 
Counting the number of "hollow" square laminae that can form one, two, three, ... distinct arrangements.
 
Counting the number of "hollow" square laminae that can form one, two, three, ... distinct arrangements.
   
Solution: This was my C++ code, published here without my permission nor any attribution, shame on whoever put it here. [user:henk263|henk263]
+
Solution: This was my C++ code, published here without my permission nor any attribution, shame on whoever put it here. [[user:henk263|henk263]]
   
 
== [http://projecteuler.net/index.php?section=problems&id=175 Problem 175] ==
 
== [http://projecteuler.net/index.php?section=problems&id=175 Problem 175] ==

Revision as of 10:24, 24 February 2008

Contents

1 Problem 171

Finding numbers for which the sum of the squares of the digits is a square.

Solution:

This does not seem Haskell code to me.
If the argument: Learning Haskell were valid pure Haskell code would have been given.
#include <stdio.h>
 
static int result = 0;
 
#define digits 20
static long long fact[digits+1];
static const long long precision      = 1000000000;
static const long long precision_mult =  111111111;
 
#define maxsquare 64 /* must be a power of 2 > digits * 9^2 */
 
static inline int issquare( int n )
{
    for( int step = maxsquare/2, i = step;;)
    {
        if( i*i == n )        return i;
        if( !( step >>= 1 ) ) return -1;
        if( i*i > n )         i -= step;
        else                  i += step;
    }
}
 
static inline void dodigit( int d, int nr, int sum, long long c, int s )
{
    if( d )
        for( int n = 0; n <= nr; c *= ++n, s += d, sum += d*d )
            dodigit( d-1, nr - n, sum, c, s );
    else if( issquare( sum ) > 0 )
        result = ( s * ( fact[digits] / ( c * fact[nr] ) )
                 / digits % precision * precision_mult
                 + result ) % precision;
}
 
int main( void )
{
    fact[0] = 1;
    for( int i = 1; i < digits+1; i++ ) fact[i] = fact[i-1]*i;
    dodigit( 9, digits, 0, 1, 0 );
    printf( "%d\n", result );
    return 0;
}
problem_171 = main

2 Problem 172

Investigating numbers with few repeated digits.

Solution:

factorial n = product [1..toInteger n]
 
fallingFactorial x n = product [x - fromInteger i | i <- [0..toInteger n - 1] ]
 
choose n k = fallingFactorial n k `div` factorial k
 
-- how many numbers can we get having d digits and p positions
p172 0 _ = 0
p172 d p 
    | p < 4 = d^p
    | otherwise = 
        (p172' p) +  p*(p172' (p-1)) + (choose p 2)*(p172' (p-2)) + (choose p 3)*(p172' (p-3))
    where
    p172' = p172 (d-1)
 
problem_172= (p172 10 18) * 9 `div` 10

3 Problem 173

Using up to one million tiles how many different "hollow" square laminae can be formed? Solution:

problem_173=
    let c=div (10^6) 4
        xm=floor$sqrt $fromIntegral c
        k=[div c x|x<-[1..xm]]
    in  sum k-(div (xm*(xm+1)) 2)

4 Problem 174

Counting the number of "hollow" square laminae that can form one, two, three, ... distinct arrangements.

Solution: This was my C++ code, published here without my permission nor any attribution, shame on whoever put it here. henk263

5 Problem 175

Fractions involving the number of different ways a number can be expressed as a sum of powers of 2. Solution:

sternTree x 0=[]
sternTree x y=
    m:sternTree y n  
    where
    (m,n)=divMod x y
findRat x y
    |odd l=take (l-1) k++[last k-1,1]
    |otherwise=k
    where
    k=sternTree x y
    l=length k
p175 x y= 
    init$foldl (++) "" [a++","|
    a<-map show $reverse $filter (/=0)$findRat x y]
problems_175=p175 123456789 987654321
test=p175 13 17

6 Problem 176

Rectangular triangles that share a cathetus. Solution:

--k=47547 
--2*k+1=95095 = 5*7*11*13*19
lst=[5,7,11,13,19]
primes=[2,3,5,7,11]
problem_176 =
    product[a^b|(a,b)<-zip primes (reverse n)]
    where
    la=div (last lst+1) 2
    m=map (\x->div x 2)$init lst
    n=m++[la]

7 Problem 177

Integer angled Quadrilaterals.

Solution:

This does not seem Haskell code to me.
If the argument: Learning Haskell were valid pure Haskell code would have been given.
 
#include <stdio.h>
#include <math.h>
// gcc --std c99 -lm 177.c
int isint(double x);
double fabs(double x);
 
long long int count;
double duparray[100][20];
 
double PIeight=3.14159265358979323846264338327950288419716939937510/180.0;
int main()
{
    double x,w,m;
    int a,b,c,d;
    double maxxvalue;
 
    int iopt;
    int I,j;
    int N;
    count=0;
    double sine[200];
    double cosine[200];
    for(int i=1;i<=180;i++)
    {
        if(i<=90)
        {
            sine[i]=sin(PIeight*(double)i);
            cosine[i]=cos(PIeight*(double)i);
        }
        else
        {
            sine[i]=sine[180-i];
            cosine[i]=-cosine[180-i];
        }
    }
 
    for(int alpha=1;alpha<=45;alpha++)
    {
        for(int beta=alpha;beta<180-alpha;beta++)
        {
 
            for(int gamma=alpha;gamma<=180-alpha-beta-alpha;gamma++)
            {
                w=sine[alpha+beta]/sine[alpha+beta+gamma];
                int b=180-alpha-beta-gamma;
                for(int delta=alpha;delta<=180-gamma-beta-alpha;delta++)
                {
                    x=sine[beta]/sine[beta+gamma+delta];
                    m=sqrt(w*w+x*x-2*w*x*cosine[delta]);
                    if(x*sine[delta]>m)
                        a=90;
                    else
                        a=(int)(round)(1.0/PIeight*asin(x*sine[delta]/m));
                    if(m*m+w*w-x*x<0)
                        a=180-a;
                    d=180-beta-gamma-delta;
 
                    c=360-a-b-alpha-beta-gamma-delta-d;
 
                    if(a>=alpha && c>=alpha && a+b+c+d+alpha+beta+gamma+delta==360)
                    {
                        if(fabs((sine[delta]*sine[c]/(sine[a]*sine[d]))-
                            (sine[gamma]*sine[alpha]/(sine[beta]*sine[b])))<1e-11)
                        {
                            duparray[1][1]=(double)alpha;
                            duparray[1][2]=(double)beta;
                            duparray[1][3]=(double)gamma;
                            duparray[1][4]=(double)delta;
                            duparray[1][5]=(double)d;
                            duparray[1][6]=(double)c;
                            duparray[1][7]=(double)a;
                            duparray[1][8]=(double)b;
                            for(I=1;I<=3;I++)
                                for(j=1;j<=8;j++)
                                    duparray[I+1][j]=duparray[1][(j+I*2-1)%8+1];
                            for(j=1;j<=8;j++)
                                duparray[5][9-j]=duparray[1][j];
 
                            for(I=1;I<=3;I++)
                                for(j=1;j<=8;j++)
                                    duparray[I+5][j]=duparray[5][(j+I*2-1)%8+1];
                            N=8;
                            maxxvalue=1e22;
                            iopt=1;
                            for(I=1;I<=N;I++)
                            {
                                duparray[I][9]=0;
                                for(j=1;j<=8;j++)
                                    duparray[I][9]=duparray[I][9]*180+duparray[I][j];
 
                                if(duparray[I][9]<maxxvalue-1e-7)
                                {
                                    maxxvalue=duparray[I][9];
                                    iopt=I;
                                }
                            }
 
 
 
                            if(iopt==1)
                                count++;
                        }
                    }
 
 
                }
            }
        }
    }
 
    printf("%lld\n",count);
 
}
problem_177 = main

8 Problem 178

Step Numbers Solution:

This does not seem Haskell code to me.
If the argument: Learning Haskell were valid pure Haskell code would have been given.
 
#include <stdio.h>
#include <math.h>
#define N 40 
 
double f[50][11][11][11];
 
int main()
{
  int x,y,z,i,j,k,m;
 
  for(m=1;m<=N;m++)
    {
  for(i=0;i<=9;i++)
    for(j=0;j<=9;j++)
      for(k=0;k<=9;k++)
	{
	  if(i==j && j==k && m==1)
	    f[m][i][j][k]=1;
	  else
	    f[m][i][j][k]=0;
	}
    }
 
  for(m=2;m<=N;m++)
    {
      for(x=0;x<=9;x++)
	{
 
	for(y=x+1;y<=9;y++)
	  for(z=x;z<=y;z++)
	    {
	      if(z>x && z<y)
		{
		  f[m][x][y][z]=f[m-1][x][y][z-1]+f[m-1][x][y][z+1];
		}
	      if(z==x)
		{
		  f[m][x][y][z]=f[m-1][x][y][x+1]+f[m-1][x+1][y][x+1];
		}
	      if(z==y)
		{
		  f[m][x][y][z]=f[m-1][x][y][y-1]+f[m-1][x][y-1][y-1];
		}
	    }
	}
    }
  double count=0;
  for(i=1;i<=N;i++)
    {
      for(z=1;z<=9;z++)
	count+=f[i][0][9][z];
    }
  printf("%lf\n",count);
}
problem_178 = main

9 Problem 179

Consecutive positive divisors.

10 Problem 180

Rational zeros of a function of three variables. Solution:

import Data.Ratio
 
{-
  After some algebra, we find:
   f1 n x y z = x^(n+1) + y^(n+1) - z^(n+1)
   f2 n x y z = (x*y + y*z + z*x) * ( x^(n-1) + y^(n-1) - z^(n-1) )
   f3 n x y z = x*y*z*( x^(n-2) + y^(n-2) - z^(n-2) )
   f n x y z = f1 n x y z + f2 n x y z - f3 n x y z
   f n x y z = (x+y+z) * (x^n+y^n-z^n)
Now the hard part comes in realizing that n can be negative.  
Thanks to Fermat, we only need examine the cases n = [-2, -1, 1, 2]
Which leads to:
 
f(-2) z = xy/sqrt(x^2 + y^2)
f(-1) z = xy/(x+y)
f(1)  z = x+y
f(2)  z = sqrt(x^2 + y^2)
 
-}
 
unique ::  Eq(a) => [a] -> [a]
unique [] = []
unique (x:xs) | elem x xs = unique xs
              | otherwise = x : unique xs
 
-- Not quite correct, but I don't care about the zeros
ratSqrt :: Rational -> Rational
ratSqrt x = 
  let a = floor $ sqrt $ fromIntegral $ numerator x
      b = floor $ sqrt $ fromIntegral $ denominator x
      c = (a%b) * (a%b)
  in if x == c then (a%b) else 0
 
-- Not quite correct, but I don't care about the zeros
reciprocal :: Rational -> Rational
reciprocal x 
  | x == 0 = 0
  | otherwise = denominator x % numerator x
 
problem_180 =
  let order = 35
      range :: [Rational]            
      range = unique [ (a%b) | b <- [1..order], a <- [1..(b-1)] ]
      fm2,fm1,f1,f2 :: [[Rational]]
      fm2 = [[x,y,z] | x<-range, y<-range, 
            let z = x*y * reciprocal (ratSqrt(x*x+y*y)), elem z range]
      fm1 = [[x,y,z] | x<-range, y<-range, 
            let z = x*y * reciprocal (x+y), elem z range]
      f1  = [[x,y,z] | x<-range, y<-range, 
            let z = (x+y), elem z range]
      f2  = [[x,y,z] | x<-range, y<-range, 
            let z = ratSqrt(x*x+y*y), elem z range]            
      result = sum $ unique $ map (\x -> sum x) (fm2++fm1++f1++f2)
  in (numerator result + denominator result)