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