Re: Fun 7th grade Algebra problem
- To: mathgroup at smc.vnet.net
- Subject: [mg34771] Re: [mg34731] Fun 7th grade Algebra problem
- From: Andrzej Kozlowski <andrzej at platon.c.u-tokyo.ac.jp>
- Date: Wed, 5 Jun 2002 03:38:36 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
A few additional remarks. First of all, the choice of 0 as a value in
the definition of power and sqrt is unfortunate. It better to use:
In[29]:=
power[x_Integer?(#>0&),y_Integer?(-16â?¤#â?¤16&)]:=x^y;
power[x_,y_]:=Indeterminate;power[x_]=Indeterminate;
In[35]:=
sqrt[x_?(#>0&)]:=Sqrt[x];sqrt[x_]:=Indeterminate;
This will produce fewer error messages when we try using different
arrangements of operators which may evaluate to 1/0. Even this change
does nto eliminate the problem, but it's not a serious one. As I pointed
out, to find more solutions one needs to try other arrangements of
operators,e .g.
sols4 = Flatten[
Union[Union[A1[B1[A2[4, B2[4]]], A3[B3[4], B4[4]]] /. rules2] /.
rules1]];
(error messages about division by 0)
In[41]:=
sols4=Union[Select[sols4,Element[#,Integers]&&1â?¤#â?¤99&]]
Out[41]=
{1,2,3,4,5,6,7,8,9,10,12,14,15,16,17,18,19,20,21,22,24,25,26,27,28,29,30,32,
\
34,36,40,42,44,45,47,48,49,54,56,60,63,64,68,72,76,80,85,88,90,94,95,96,97}
In[33]:=
Complement[sols4,sols1,sols2]
Out[33]=
{90}
In[38]:=
patterns=Flatten[
Union[HoldForm/@(Union[
A1[B1[A2[4,B2[4]]],A3[B3[4],B4[4]]]]/.rules2)/.rules1]];
In[39]:=
Select[patterns,ReleaseHold[#]==90&]
Out[39]=
{4 24-(4+2),4 24-(4+2),4 24-(4+2),4 24-(4+2),4 24-(4+2),24 4-(4+2),24
4-(4+2),
24 4-(4+2),24 4-(4+2),24 4-(4+2)}
So we found that 90 can be represented as 4*4!-(4+Sqrt[4]). So far we
have found
In[40]:=
sols=Union[sols1,sols2,sols4]
Out[40]=
{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,
\
29,30,31,32,33,34,36,39,40,41,42,44,45,46,47,48,49,50,52,54,56,58,60,63,64,
65,\
66,68,70,72,74,76,78,80,81,82,84,85,88,90,92,93,94,95,96,97,98,99}
which means that there are
In[410]:=
Complement[Range[99],sols]//Length
Out[41]=
23
left for those who like this sort of thing.
Andrzej
On Wednesday, June 5, 2002, at 01:02 PM, Andrzej Kozlowski wrote:
> Similar questions to this one are periodically sent to this list, I
> remember myself answering one about 2 years ago (it concenred a Chinese
> card game). There are countless ways of doing this sort of thing in
> Mathematica, and the programming is not difficult but tedious. Since
> this is hardly an Nobel prize level problem you won't find many people
> willing to devote serious time to it. Having said that, here is a quick
> attempt with a brief commentary:
>
> First I define modified functions power and sqrt to avoid errors due to
> the wrong type of arguments and overflow problems which you get if you
> use to large powers.
>
> power[x_Integer?(# > 0 &), y_Integer?(-16 â?¤ # â?¤ 16 &)] := x^y;
> power[x_, y_] := 0; power[x_] = 0;
>
> sqrt[x_?(# â?¥ 0 &)] := Sqrt[x]; sqrt[x_] := 0;
>
> We shall use two types of functions, those that take two (actually
> more) arguments: {Times, Plus, power} and those that accept only one
> argument:
> {Identity, Factorial, (1/#) &, -# &, sqrt}. We shall make two sets of
> rules for each type of functions which we regard as interchangable in
> our expressions:
>
> In[3]:=
> rules1=Map[Thread,
> Map[RuleDelayed[{A1, A2,A3}, #] &,
> Distribute[{{Times, Plus,power}, {Times, Plus,power}, {Times,
> Plus,
> power}},List]]];
>
> In[4]:=
> rules2=Map[Thread,
> Map[RuleDelayed[{B1, B2,B3,B4,B5}, #] &,
> Distribute[{{Identity,Factorial, (1/#)&,-#&,sqrt}, {Identity,
> Factorial, (1/#)&,-#&,sqrt},{Identity,Factorial,
> (1/#)&,-#&,
> sqrt},{Identity,Factorial, (1/#)&,-#&,sqrt},{Identity,
> Factorial, (1/#)&,-#&,sqrt}},List]]];
>
> The variables A1, A2, A3 stand for any function of the first type, B1
> etc for any function of the second type. Now all we need to do is to
> write a typical algebraic expression with four 4's and a suitable
> number of A's and B's and substitute our rules.
>
> sols1 = Flatten[
> Union[Union[A1[A2[B1[4], B2[4]], A3[B3[4], B4[4]]] /. rules2] /.
> rules1]];
>
> We select from these those that satisfy the conditions of the problem:
>
> In[7]:=
> sols1=Union[Select[sols1,Element[#,Integers]&&1â?¤#â?¤99&]]
>
> Out[7]=
> {1,2,3,4,5,6,7,8,9,10,12,13,14,15,16,17,18,19,20,21,22,24,25,26,27,28,29,
> 30,
> 32,34,36,40,42,44,45,46,47,48,49,52,54,56,60,63,64,68,74,76,80,85,88,94,95,
> 96,
> 97}
>
> of course these are only the answers you get from the arrangement of
> operators: A1[A2[B1[4], B2[4]], A3[B3[4], B4[4]].Suppose we would like
> to know how, say, 74 was represented in this form. We must first make a
> list of unevaluated patterns:
>
> In[8]:=
> patterns=Flatten[
> Union[HoldForm/@(Union[
> A1[A2[B1[4],B2[4]],A3[B3[4],B4[4]]]/.rules2])/.rules1]];
>
> In[9]:=
> Select[patterns,ReleaseHold[#]==74&]
>
> Out[9]=
> {(2+24)+2 24,(2+24)+24 2,(24+2)+2 24,(24+2)+24 2,2 24+(2+24),2
> 24+(24+2),
> 24 2+(2+24),24
> 2+(24+2),(2+24)+(24+24),(24+2)+(24+24),(24+24)+(2+24),(24+24)+(24+2)}
>
> Of course 24 is 4! and 2 is Sqrt[4] (they got evaluated before we
> applied HoldForm). We coudl have aranged for these expressions to be
> held also but it will further slow down the computation and we can
> indentify them anyway. So you can tell that the first answer is
> Sqrt[4]+4!+Sqrt[4]*4! and so on.
>
> Next we try another arrangement of the operators:
>
> In[10]:=
> sols2=Flatten[
>
> Union[Union[A1[A3[B1[4],A2[B2[4],B3[4]]],B4[4]]/.rules2]/.rules1]];
>
> In[11]:=
> sols2=Union[Select[sols2,Element[#,Integers]&&1â?¤#â?¤99&]]
>
> Out[11]=
> {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,
> 28,
> \
> 29,30,31,32,33,34,36,39,40,41,42,44,46,47,48,49,50,52,54,56,58,60,63,64,65,
> 66,\
> 68,70,72,74,76,78,80,81,82,84,88,92,93,94,96,97,98,99}
>
> Let's see if we got anything new.
>
> In[12]:=
> Complement[sols2,sols1]
>
> Out[12]=
> {11,23,31,33,39,41,50,58,65,66,70,72,78,81,82,84,92,93,98,99}
>
> We can check how many numbers we still have not accounted for so far :
>
> In[13]:=
> Complement[Range[99],sols1,sols2]
>
> Out[13]=
> {35,37,38,43,51,53,55,57,59,61,62,67,69,71,73,75,77,79,83,86,87,89,90,91}
>
> In[14]:=
> Length[%]
>
> Out[14]=
> 24
>
> You can try more arrangements of operators and perhaps you can
> represent some or all of the remaining numbers. However, Since you
> have allowed Sqrt and Factorial to be used and since 0!==1!=1 and
> Sqrt[0]==0, Sqrt[1]==1, every number that can be represented can be
> represented in infinitely many ways, so there is no point trying to
> write a program that will find all of them.
>
>
>
> On Tuesday, June 4, 2002, at 04:41 PM, johnnyturpin wrote:
>
>> I know this as the "four fours" problem, and I remember it from my 7th
>> grade
>> Algebra class as an extra credit assignment, but recently it has been
>> entertaining all the puzzle solvers at my work. Being a 'C'
>> programmer, I am
>> sure I could whip out a 'C' program to help solve this, but being new
>> to
>> Mathematica I don't know where to start. Here is the problem:
>>
>> Find the numbers 0 to 99 using any rational operator (i.e. an operation
>> which results in a rational number) and 4 fours, i.e., each equation
>> must
>> contain no more or no less than 4 fours. Not all numbers may be
>> possible.
>>
>> Some examples:
>>
>> 0 = 4 + 4 - 4 - 4
>> 1 = 4/4 + (4 - 4)
>> 2 = 4/4 + 4/4
>> 27 = 4! + 4/4 + sqrt(4)
>>
>>
>> The operators I remember to be valid (other than the obvious +, -, *, /
>> include:
>>
>> () (Parenthesis for grouping)
>> ! (factorial)
>> Sqrt ( square root)
>> X^y (exponent)
>>
>> --- I am not sure about the following:
>> Min()
>> Max()
>> Floor()
>> Ceiling()
>>
>> I am not sure if these can be thought of as "operators" and I don't
>> remember
>> using them...
>>
>>
>>
>>
>> Ok, I realize that fundamentally factorial and square root include
>> numbers
>> which are not fours (4 factorial = 4 * 3 * 2 * 1, and sqrt(4) = 4^1/2,
>> but
>> for the sake of this puzzle, these can be thought of as integer
>> operators
>> when applied to the number 4.
>>
>> We are still working on 0 - 50 manually. 31 stumped us for several
>> days...
>>
>>
>>
>>
>>
>