A61 == The reason that ComplexMap1 does not load is that Roman has not set it up asa package that can load. You can only look at it as a text file to see whatan early version of the package looked like. That is because he has theBegin statement:BeginPackage[ProgrammingInMathematica`ComplexMap`] and it should beBeginPackage[ProgrammingInMathematica`ComplexMap1`]to be correct for loading. ProgrammingInMathematica gives the folder nameand ComplexMap1 would give the specific file name.He intends that you actually use the ComplexMap package. (You could also useGraphics`ComplexMap`.)The advantage of the Needs statement over Get is that it can be reevaluatedand if the package is already loaded it will do nothing. Many packagesgenerally more convenient to use Needs. For example, if you open twodifferent notebooks that both use the same package and both haveinitialization cells to load the package, the package will only be loadedonce.David Parkdjmp@earthlink.nethttp://home.earthlink.net/~djmp/Needs[ ProgrammingInMathematica`ComplexMap1`]instead of<> and it should be>> BeginPackage[ProgrammingInMathematica`ComplexMap1`]>> to be correct for loading. ProgrammingInMathematica gives the folder name> and ComplexMap1 would give the specific file name.>> He intends that you actually use the ComplexMap package. (You could also use> Graphics`ComplexMap`.)>> The advantage of the Needs statement over Get is that it can be reevaluated> and if the package is already loaded it will do nothing. Many packages> generally more convenient to use Needs. For example, if you open two> different notebooks that both use the same package and both have> initialization cells to load the package, the package will only be loaded> once.>> David Park> djmp@earthlink.net> http://home.earthlink.net/~djmp/>> I am new to Mathematica and now reading Programming In Mathematica.> I am a little confused with Needs[ ] & Get[ ].> I kow that Needs[ ] checks $Packages whether the package is present or> not and I usually use Needs[ ] to load a package.> On the xiv page of ProgrammingInMathematica it says Even better is> Needs[ProgrammingInmathematica`Package`]........> but on page 13,> when I input> Needs[ProgrammingInMathematica`ComplexMap1`]> instead of> < an error occurs:> Needs::nocont: Context ProgrammingInMathematica`ComplexMap1` was not> created when Needs was evaluated.>> I don't know why, for the Help says Needs[context`] calls> Get[context`]. By convention, the file loaded in this way is the one> which contains a package that defines context`. >> I execute Mathematica 4.1 on Windows98>Reply-To: drbob@bigfoot.com ==== Paul,Perhaps I'm missing something, but these graphs seem to contain no information about how games are arranged in time. They merely record the results, in terms of who beat whom in each possible pairing. Nor are score sequences of any use for laying out a tournament, despite the term sequence that sometimes indicates ordering or chronology (but not in this case).So... I'm not sure I can agree that these are graphical representations of tournaments.I am in favor of Swiss system tournaments (commonly used in Chess matches), rather than the exhaustive (and inefficient) tournaments we're talking about here.Swiss system tournaments match up roughly comparable opponents in each round, so that at the end, we don't have controversies about how tough each team's schedule was. The result would be NBA or football playoffs that include the best teams. The down-sides are (1) that the schedule couldn't be determined before the season begins, and (2) by mid-season, losers would be playing losers, so those games would probably be canceled if ticket sales are the goal.The latter is a down-side only for losing teams, however --- but a big plus for fans.BobbyOn Sat, 22 Mar 2003 05:08:30 -0500 (EST), Paul Abbott > I've got a puzzle, im not sure how to solve, a friend of mine asked>> me to make a program that given a number of teams (which must be more>> than 4 but other than that just dividable by 2) - now, there is>> teams2 matches in a round, and no team must play more than 1 match>> in a round (making the number of rounds teams-1).>> There is a Mathematica Notebook at>> http://mathworld.wolfram.com/Tournament.html>> which gives graphical (pun intended) representations of tournaments.> Paul>-- majort@cox-internet.comBobby R. Treat ==== Hi,Is there any official site that gives a list of known problemswith the various versions of Mathematica under various operatingsystems? Such a site could save Mathematica users a lot for time!(I have recently wasted a lot of time due to problems withConstrainedMin, one of Mathematica's linear programming functions.See my previous post from today.)Uri--------------------------------------------------- ------------------| Prof. Uri Zwick | http://www.cs.tau.ac.il/~zwick || Dept. of Computer Science | zwick@tau.ac.il || ISRAEL | FAX: +972 3 6409357 |------------------------------------------------------------ --------- ==== Peter,This is not a totally responsive answer but a piece of advice. I wouldalways put packages in directories that are intended to hold packages.Namely I would put them in AddOnsExtraPackages or AddOnsApplications.Mathematica automatically knows how to find them there. If you put themsomewhere else, and you intend that other people use the package, then theyare going to run into the same problem that you just ran into. If peoplecan't load your package there is little chance they will use it.It is best if a package is set up so that it loads and behaves just like theMathematica standard packages. Some beginners have enought trouble in justloading those.David Parkdjmp@earthlink.nethttp://home.earthlink.net/~djmp/Ideas? Peter W ==== Hi,I am encountering another problem with ConstrainedMin.(For the previous one, see my previous posting from February 26.)This time it is a serious numerical problem that occurs underMathematica 4.2 for Windows but not under Mathematica 4.1 for LINUX.I am solving a relatively simple linear program in only twovariables x,y. There are 48 inequalities, each of the forma + b*x + c*y >=0 , where a is negative and b and c are positive.The numbers a,b,c all have a precision of 17.The inequalities are:In[1] :=ineq = {-2.34619140625`17 + 0.080078125`17*x + 0.04443359375`17*y >= 0, -2.375`17 + 0.125`17*x + 0.0625`17*y >= 0, -1.6796875`17 + 0.09375`17*x + 0.0703125`17*y >= 0, -4.9342041015625`17 + 0.14111328125`17*x + 0.0716552734375`17*y >=0, -6.408050537109375`17 + 0.1361083984375`17*x +0.072174072265625`17*y >= 0, -3.9736328125`17 + 0.12890625`17*x + 0.0732421875`17*y >= 0, -7.364093780517578125`17 + 0.1480865478515625`17*x + 0.079021453857421875`17*y >= 0, -6.0248260498046875`17 + 0.15374755859375`17*x + 0.0811309814453125`17*y >= 0, -7.32013702392578125`17 + 0.160064697265625`17*x + 0.08586883544921875`17*y >= 0, -6.82013702392578125`17 + 0.160064697265625`17*x + 0.08586883544921875`17*y >= 0, -5.537353515625`17 + 0.1533203125`17*x + 0.087646484375`17*y >= 0, -5.037353515625`17 + 0.1533203125`17*x + 0.087646484375`17*y >= 0, -3.6923828125`17 + 0.16015625`17*x + 0.0888671875`17*y >= 0, -6.615447998046875`17 + 0.1663818359375`17*x +0.090606689453125`17*y >= 0, -6.115447998046875`17 + 0.1663818359375`17*x + 0.090606689453125`17*y >= 0, -5.69354248046875`17 + 0.179443359375`17*x + 0.09356689453125`17*y >= 0, -1.40625`17 + 0.125`17*x + 0.09375`17*y >= 0, -5.3497314453125`17 + 0.20556640625`17*x + 0.0994873046875`17*y >=0, -4.60107421875`17 + 0.177734375`17*x + 0.10205078125`17*y >= 0, -3.26953125`17 + 0.140625`17*x + 0.10546875`17*y >= 0, -2.76953125`17 + 0.140625`17*x + 0.10546875`17*y >= 0, -4.509765625`17 + 0.1953125`17*x + 0.115234375`17*y >= 0, -4.009765625`17 + 0.1953125`17*x + 0.115234375`17*y >= 0, -9.4328899383544921875`17 + 0.25582122802734375`17*x + 0.1202716827392578125`17*y >= 0, -3.75`17 + 0.25`17*x +0.125`17*y >= 0, -2.375`17 + 0.5`17*x + 0.125`17*y >= 0, -1.375`17 + 0.5`17*x + 0.125`17*y >= 0, -6.725830078125`17 + 0.2822265625`17*x + 0.125732421875`17*y >= 0, -5.725830078125`17 + 0.2822265625`17*x + 0.125732421875`17*y >= 0, -2.859375`17 + 0.1875`17*x + 0.140625`17*y >= 0, -2.359375`17 + 0.1875`17*x + 0.140625`17*y >= 0, -4.73046875`17 + 0.359375`17*x + 0.14453125`17*y >= 0, -3.73046875`17 + 0.359375`17*x + 0.14453125`17*y >= 0, -10.90069580078125`17 + 0.385009765625`17*x + 0.17547607421875`17*y>= 0, -9.90069580078125`17 + 0.385009765625`17*x + 0.17547607421875`17*y >= 0, -2.3125`17 + 0.25`17*x + 0.1875`17*y>= 0, -1.8125`17 + 0.25`17*x + 0.1875`17*y >= 0, -8.10546875`17 + 0.484375`17*x + 0.20703125`17*y >= 0, -7.10546875`17 + 0.484375`17*x + 0.20703125`17*y >= 0, -14.8677978515625`17 + 0.45556640625`17*x + 0.2113037109375`17*y >=0, -13.8677978515625`17 + 0.45556640625`17*x + 0.2113037109375`17*y >=0, -4.78125`17 + 0.625`17*x + 0.21875`17*y >= 0, -3.78125`17 + 0.625`17*x + 0.21875`17*y >= 0, -17.865779876708984375`17 + 0.5116424560546875`17*x + 0.240543365478515625`17*y >= 0, -1.75`17 + 1.`17*x + 0.25`17*y >=0, -10.45166015625`17 + 0.564453125`17*x + 0.25146484375`17*y >= 0, -6.4609375`17 + 0.71875`17*x + 0.2890625`17*y >= 0, -0.5`17 + 0.5`17*y >= 0}I try to minimize x+y under these constraints.The result I get is a complete nonsense:In[2] := ConstrainedMin[x + y, ineq, {x, y}]Out[2] = !({0``-1.6966, {x [Rule] 0.`, y [Rule] 0.`}})Note that the solution {x->0.,y->0.} satisfies NONEof the constraints of the problem.Using Mathematica 4.1 for LINUX I get the (hopefully) correct result:Out[2] = {50.1946934554904018455090408679`16.699, {x -> 49.1946934554904053982227196684`17, y -> 1.`17}}Did anyone encounter similar problems with ConstrainedMin?In any case, use ConstrainedMin with great caution!Uri-------------------------------------------------- -------------------| Prof. Uri Zwick | http://www.cs.tau.ac.il/~zwick || Dept. of Computer Science | zwick@tau.ac.il || ISRAEL | FAX: +972 3 6409357 |------------------------------------------------------------ --------- ==== The inequalities are:In[1] :=ineq = {-2.34619140625`17 + 0.080078125`17*x + 0.04443359375`17*y >= 0, -2.375`17 + 0.125`17*x + 0.0625`17*y >= 0, -1.6796875`17 + 0.09375`17*x + 0.0703125`17*y >= 0, -4.9342041015625`17 + 0.14111328125`17*x + 0.0716552734375`17*y >=0, -6.408050537109375`17 + 0.1361083984375`17*x +0.072174072265625`17*y >= 0, -3.9736328125`17 + 0.12890625`17*x + 0.0732421875`17*y >= 0, -7.364093780517578125`17 + 0.1480865478515625`17*x + 0.079021453857421875`17*y >= 0, -6.0248260498046875`17 + 0.15374755859375`17*x + 0.0811309814453125`17*y >= 0, -7.32013702392578125`17 + 0.160064697265625`17*x + 0.08586883544921875`17*y >= 0, -6.82013702392578125`17 + 0.160064697265625`17*x + 0.08586883544921875`17*y >= 0, -5.537353515625`17 + 0.1533203125`17*x + 0.087646484375`17*y >= 0, -5.037353515625`17 + 0.1533203125`17*x + 0.087646484375`17*y >= 0, -3.6923828125`17 + 0.16015625`17*x + 0.0888671875`17*y >= 0, -6.615447998046875`17 + 0.1663818359375`17*x +0.090606689453125`17*y >= 0, -6.115447998046875`17 + 0.1663818359375`17*x + 0.090606689453125`17*y >= 0, -5.69354248046875`17 + 0.179443359375`17*x + 0.09356689453125`17*y >= 0, -1.40625`17 + 0.125`17*x + 0.09375`17*y >= 0, -5.3497314453125`17 + 0.20556640625`17*x + 0.0994873046875`17*y >=0, -4.60107421875`17 + 0.177734375`17*x + 0.10205078125`17*y >= 0, -3.26953125`17 + 0.140625`17*x + 0.10546875`17*y >= 0, -2.76953125`17 + 0.140625`17*x + 0.10546875`17*y >= 0, -4.509765625`17 + 0.1953125`17*x + 0.115234375`17*y >= 0, -4.009765625`17 + 0.1953125`17*x + 0.115234375`17*y >= 0, -9.4328899383544921875`17 + 0.25582122802734375`17*x + 0.1202716827392578125`17*y >= 0, -3.75`17 + 0.25`17*x +0.125`17*y >= 0, -2.375`17 + 0.5`17*x + 0.125`17*y >= 0, -1.375`17 + 0.5`17*x + 0.125`17*y >= 0, -6.725830078125`17 + 0.2822265625`17*x + 0.125732421875`17*y >= 0, -5.725830078125`17 + 0.2822265625`17*x + 0.125732421875`17*y >= 0, -2.859375`17 + 0.1875`17*x + 0.140625`17*y >= 0, -2.359375`17 + 0.1875`17*x + 0.140625`17*y >= 0, -4.73046875`17 + 0.359375`17*x + 0.14453125`17*y >= 0, -3.73046875`17 + 0.359375`17*x + 0.14453125`17*y >= 0, -10.90069580078125`17 + 0.385009765625`17*x + 0.17547607421875`17*y>= 0, -9.90069580078125`17 + 0.385009765625`17*x + 0.17547607421875`17*y >= 0, -2.3125`17 + 0.25`17*x + 0.1875`17*y>= 0, -1.8125`17 + 0.25`17*x + 0.1875`17*y >= 0, -8.10546875`17 + 0.484375`17*x + 0.20703125`17*y >= 0, -7.10546875`17 + 0.484375`17*x + 0.20703125`17*y >= 0, -14.8677978515625`17 + 0.45556640625`17*x + 0.2113037109375`17*y >=0, -13.8677978515625`17 + 0.45556640625`17*x + 0.2113037109375`17*y >=0, -4.78125`17 + 0.625`17*x + 0.21875`17*y >= 0, -3.78125`17 + 0.625`17*x + 0.21875`17*y >= 0, -17.865779876708984375`17 + 0.5116424560546875`17*x + 0.240543365478515625`17*y >= 0, -1.75`17 + 1.`17*x + 0.25`17*y >=0, -10.45166015625`17 + 0.564453125`17*x + 0.25146484375`17*y >= 0, -6.4609375`17 + 0.71875`17*x + 0.2890625`17*y >= 0, -0.5`17 + 0.5`17*y >= 0}I try to minimize x+y under these constraints.The result I get is a complete nonsense:In[2] := ConstrainedMin[x + y, ineq, {x, y}]Out[2] = !({0``-1.6966, {x [Rule] 0.`, y [Rule] 0.`}})Note that the solution {x->0.,y->0.} satisfies NONEof the constraints of the problem.Using Mathematica 4.1 for LINUX I get the (hopefully) correct result:Out[2] = {50.1946934554904018455090408679`16.699, {x -> 49.1946934554904053982227196684`17, y -> 1.`17}}Did anyone encounter similar problems with ConstrainedMin?In any case, use ConstrainedMin with great caution!>>4.2 for Mac OS X (August 22, 2002)ConstrainedMin[x+y,ineq,{x,y}]{0``-1.6966, {x -> 0., y -> 0.}}You can workaround the problem by using RationalizeConstrainedMin[x+y,Rationalize[ineq,0],{x,y}]{ 974279/19410, {x -> 954869/19410, y -> 1}}N[%, 17]{50.1946934569809376609994836283`17, {x -> 49.1946934569809376609994837644`17, y -> 1.`17}}Bob Hanlon ==== Hi,I am running into another problem with ConstrainedMin.(For the first problem, see my previous posting from February 26.)This time it is a serious numerical problem. It occurs underWindows, but not under LINUX!I am solving a relatively simple linear program in only twovariables x,y. There are 48 inequalities, each of the forma + b*x + c*y >=0 , where a is negative and b and c are positive.The numbers a,b,c all have a precision of 17.The inequalities are:In[1] :=ineq = {-2.34619140625`17 + 0.080078125`17*x + 0.04443359375`17*y >= 0, -2.375`17 + 0.125`17*x + 0.0625`17*y >= 0, -1.6796875`17 + 0.09375`17*x + 0.0703125`17*y >= 0, -4.9342041015625`17 + 0.14111328125`17*x + 0.0716552734375`17*y >=0, -6.408050537109375`17 + 0.1361083984375`17*x +0.072174072265625`17*y >= 0, -3.9736328125`17 + 0.12890625`17*x + 0.0732421875`17*y >= 0, -7.364093780517578125`17 + 0.1480865478515625`17*x + 0.079021453857421875`17*y >= 0, -6.0248260498046875`17 + 0.15374755859375`17*x + 0.0811309814453125`17*y >= 0, -7.32013702392578125`17 + 0.160064697265625`17*x + 0.08586883544921875`17*y >= 0, -6.82013702392578125`17 + 0.160064697265625`17*x + 0.08586883544921875`17*y >= 0, -5.537353515625`17 + 0.1533203125`17*x + 0.087646484375`17*y >= 0, -5.037353515625`17 + 0.1533203125`17*x + 0.087646484375`17*y >= 0, -3.6923828125`17 + 0.16015625`17*x + 0.0888671875`17*y >= 0, -6.615447998046875`17 + 0.1663818359375`17*x +0.090606689453125`17*y >= 0, -6.115447998046875`17 + 0.1663818359375`17*x + 0.090606689453125`17*y >= 0, -5.69354248046875`17 + 0.179443359375`17*x + 0.09356689453125`17*y >= 0, -1.40625`17 + 0.125`17*x + 0.09375`17*y >= 0, -5.3497314453125`17 + 0.20556640625`17*x + 0.0994873046875`17*y >=0, -4.60107421875`17 + 0.177734375`17*x + 0.10205078125`17*y >= 0, -3.26953125`17 + 0.140625`17*x + 0.10546875`17*y >= 0, -2.76953125`17 + 0.140625`17*x + 0.10546875`17*y >= 0, -4.509765625`17 + 0.1953125`17*x + 0.115234375`17*y >= 0, -4.009765625`17 + 0.1953125`17*x + 0.115234375`17*y >= 0, -9.4328899383544921875`17 + 0.25582122802734375`17*x + 0.1202716827392578125`17*y >= 0, -3.75`17 + 0.25`17*x +0.125`17*y >= 0, -2.375`17 + 0.5`17*x + 0.125`17*y >= 0, -1.375`17 + 0.5`17*x + 0.125`17*y >= 0, -6.725830078125`17 + 0.2822265625`17*x + 0.125732421875`17*y >= 0, -5.725830078125`17 + 0.2822265625`17*x + 0.125732421875`17*y >= 0, -2.859375`17 + 0.1875`17*x + 0.140625`17*y >= 0, -2.359375`17 + 0.1875`17*x + 0.140625`17*y >= 0, -4.73046875`17 + 0.359375`17*x + 0.14453125`17*y >= 0, -3.73046875`17 + 0.359375`17*x + 0.14453125`17*y >= 0, -10.90069580078125`17 + 0.385009765625`17*x + 0.17547607421875`17*y>= 0, -9.90069580078125`17 + 0.385009765625`17*x + 0.17547607421875`17*y >= 0, -2.3125`17 + 0.25`17*x + 0.1875`17*y>= 0, -1.8125`17 + 0.25`17*x + 0.1875`17*y >= 0, -8.10546875`17 + 0.484375`17*x + 0.20703125`17*y >= 0, -7.10546875`17 + 0.484375`17*x + 0.20703125`17*y >= 0, -14.8677978515625`17 + 0.45556640625`17*x + 0.2113037109375`17*y >=0, -13.8677978515625`17 + 0.45556640625`17*x + 0.2113037109375`17*y >=0, -4.78125`17 + 0.625`17*x + 0.21875`17*y >= 0, -3.78125`17 + 0.625`17*x + 0.21875`17*y >= 0, -17.865779876708984375`17 + 0.5116424560546875`17*x + 0.240543365478515625`17*y >= 0, -1.75`17 + 1.`17*x + 0.25`17*y >=0, -10.45166015625`17 + 0.564453125`17*x + 0.25146484375`17*y >= 0, -6.4609375`17 + 0.71875`17*x + 0.2890625`17*y >= 0, -0.5`17 + 0.5`17*y >= 0}When I try to minimize x+y under these constraints, usingMathematica 4.2 for Windows, I get a nonsense solution:In[2] := ConstrainedMin[x + y, ineq, {x, y}]Out[2] := !({0``-1.6966, {x [Rule] 0.`, y [Rule] 0.`}})Note that the solution { x->0. , y->0. } satisfies NONE ofthe constraints!Using Mathematica 4.1 for LINUX I get the (hopefully) correct solution:{50.1946934554904018455090408679`16.699, {x -> 49.1946934554904053982227196684`17, y -> 1.`17}}Did anyone else encountered similar problems?In any case, use ConstrainedMin with great caution!Uri-------------------------------------------------- -------------------| Prof. Uri Zwick | http://www.cs.tau.ac.il/~zwick || Dept. of Computer Science | zwick@tau.ac.il || ISRAEL | FAX: +972 3 6409357 |------------------------------------------------------------ --------- ==== > for someone who has done this sort of thing with Mathematica),> Is there a way in Mathematica to show the following? The topic is Finite> Fields and Polynomials. I'll give detailed examples and I believe> Mathematica can do this sort of thing, I'm just not sure how.> 1. Let F be the field Z{2} = {0, 1}; then f = x^2 + x + 1 is an irreducible> polynomial of degree 2 over Z{2}. Hence Z{2}[x ]/ (x^2+x+1) is a field> whose elements can be represented in the form a + b*alpha, a, b elements> Z{2}, where alpha satisifes f(alpha) = 0, so alpha^2 + alpha+1=0, which> menas that alpha^2 = alpha + 1.> Hence Z{2}[x] / (x^2 + x + 1) is a field with four elements: Z{2}[x] / (x^2> + x + 1) = {0, 1, alpha, 1 + alpha}.> Can Mathematica show this, that is find the irreducible polynomial of some> degree chosen by the user and then generate the elements of the field?> 2. We determine the elements of F{2^3}, states F-sub-2^3.> a. If we regard F{2^3} as a simple extension of degree 3 of the prime field> F{2}, then this extension is obtained by adjoining to F{2} a root of an> irreducible cubic polynomial over F{2}.> It is easily verified that x^3 + x + 1 and x^3 + x^2 + 1 are irreducible> over F{2} (can Mathematica give me these orreducibles?).> Therefore F{2^3} is isomorphic F{2}[x] / (x^3 + x + 1) and also F{2^3} is> isomorphic F{2}[x] / (x^3 + x^2 + 1) .> Let alpha be a root of f = x^3 + x + 1, then 1, alpha, alpha^2 form a basis> of F{2^3} over F{2}.> The elements of F{2^3} are of the form a + b*alpha + c*alpha^2 for all a, b,> c, elements of F{2} with alpha^3 + alpha + 1 = 0 (see 1. above for example).> I'd like to be able to show that list (table) in Mathematica, is there a command or> set of commands?The code below should get you started.randomPoly[deg_, mod_, x_] := x^deg + Table[Random[Integer,{0,mod-1}], {deg}] . x^Range[0,deg-1]randomIrreduciblePoly[deg_, mod_, x_] := Module[{defpoly}, While[Length[FactorList[defpoly=randomPoly[deg,mod,x]]]!=2]; defpoly ]You can also generate all monic polynomials of given degree and modulus,and test each for irreducibility. This will be costly if degree and/ormodulus is large.To generate the elements you don't even need to know the irreducible(you will need it for multiplication).elements[deg_, mod_, x_] := Flatten[Outer[List,Apply[Sequence,Table[Range[mod]-1,{deg}]]] ,deg-1] . x^Range[0,deg-1]Note that for large fields you'd not want to do this. Also note that youcan just as well represent them by the integer vectors.> b. We could also use g = x^3 + x^2 + 1 to determine the elements of F{2^3}.> Let beta be a root of root of g, so Beta^3 + beta^2 + 1 = 0.> It can easily be verified that beta + 1 is a root of f in F{2}[x] / (g) (can> Mathematica just find that root?).Start with the assumption that the root is linear in beta.betaplus = beta+a;Form the polynomial that we desire to set to zero. Reduce it by thedefining polynomial for beta.zero = Last[PolynomialReduce[betaplus^3+betaplus+1, beta^3 + beta^2 + 1, {beta,a}, Modulus->2]]Now solve for the undetermined coefficient Ôa'.a /. SolveAlways[{zero==0, Modulus==2}, beta]> The two fields F{2}[x] / (f) and F{2}[x] / (g) are splitting fields of> x^8 - x and are thus isomorphic. Therefore, there is an isomoprhism psi> such that psi(alpha) = beta + 1 and psi restricted to F{2} is the identity> mapping.> The elements 1, beta + 1, (beta + 1)^2 for a basis of F{2}[x] / (g) over> F{2} (can we show this in Mathematica)? Thus, the isopmorphism psi is given by psi(a> + b*alpha + c*alpha^2) = a + b(beta + 1) + c(beta + 1)^2 with a, b, c,> elements of F{2}.> Then showing the mulitplication table of the multiplicative group F{2}[x] /> (x^3 + x^2 + 1){0} (can Mathematica show that?), we can arrive at:> F{2}[x] / (g) = {0, 1, beta, beta+1, beta^2, beta^2+beta, beta^2+1,> b^2+beta+1} = {0, 1, beta, beta^2, beta^3, beta^4, beta^5, beta^6} with> beta^3 = beta^2 + 1 and beta^7 = 1.> Basically, can these sorts of things be found in Mathematica and shown using table?> You can do multiplication of field elements simply by multiplying thepolynomials and then reducing viaPolynomialMod[poly, {definingpolynomial, mod}]For example:In[94]:= PolynomialMod[(1+beta+beta^2)*(1+beta^2), {beta^3 + beta^2 +1,2}]Out[94]= 1Setting up a table is just a matter of iterating over all pairs ofelements with this operation.If so desired, you can also find a multiplicative representation via aprimitive (as opposed to merely irreducible) defining polynomial. See,for example,http://forums.wolfram.com/mathgroup/archive/1998/Nov/ msg00194.htmlDaniel LichtblauWolfram Research ==== BaseForm uses lower case letters and prints the subscript 16after each number. Is there a way to print a list whose elements areintegers 0 through 15 using 0,1,...,9,A,B,C,D,E,F without thesubscript 16? E.g. {8,13,11,3} should appear as {8,D,B,3}. ==== How can I get mathematica to plot a sequence that's defined recursively e.g.a_0 = 6a_(n+1) = a_n / (2n - 7) ==== I am not a frequent user of Mathematica and many of you have assisted me in the past with implicit plots and vertical tangent lines etc.Now I have to teach slope fields to my AP Calculus students, and while we can see them on the TI calculators, I would like to generate some using Mathematica so I can make some good print-outs. I have used vector plots in the past to illustrate the main ideas, but they don't look like the slope fields in texts and on AP's.Can anyone help me on this?Tom Moriarty ==== I've just run across the following strange behavior of Simplify.(Using Mathematica 4.1.5, Mac OS X).These first two commands work as expected: Simplify[Exp[2*n*(Log[1 + t] - Log[1 - t])]] (1 - t)^(-2*n) (1 + t)^(2*n) Simplify[Exp[n^2*(Log[1 + t] - Log[1 - t])]] (1 - t)^(-n^2) (1 + t)^(n^2)But Simplify refuses to do anything with this: Simplify[Exp[2*n^2*(Log[1 + t] - Log[1 - t])]] Exp[2*n^2*(Log[1 + t] - Log[1 - t])]Can anyone shed some light here? By the way, FullSimplify does the same thing.-----Selwyn Hollishttp://www.math.armstrong.edu/faculty/hollis ==== 4.2 for Mac OS X (August 22, 2002)expr = Exp[2*n^2*(Log[1 + t] - Log[1 - t])];expr // ExpandAll // Simplify(1 + t)^(2*n^2)/(1 - t)^(2*n^2)FullSimplify[expr, ComplexityFunction -> Length](1 + t)^(2*n^2)/(1 - t)^(2*n^2)Bob Hanlon Simplify[Exp[2*n^2*(Log[1 + t] - Log[1 - t])]] Exp[2*n^2*(Log[1 + t] - Log[1 - t])]Can anyone shed some light here? By the way, FullSimplify does the same thing. >>

Reply-To: kuska@informatik.uni-leipzig.de ==== Hi,but Mathematica must do something with the right hand side of RuleDelayed[] otherwisehow become you rule a member of DownValues[] ??Since Catch[] and Throw[] are non-local operations,a Throw[] can not protected by the processingof the right hand side. Just useClear[a, z];Catch[ z[x_Integer] := 2; z[x_] := Throw[11]; a[i_, iUp_?z] := 3; a[i_Integer, iUp_?z] := 5; ] Jens> Why does the following code cause and exception? I thought that the> left hand side of := was not evaluated.> Clear[a, z];> z[x_Integer] := 2;> z[x_] := Throw[11];> a[i_, iUp_?z] := 3;> a[i_Integer, iUp_?z] := 5;> Hein ==== >-----Original Message----->Sent: Thursday, April 03, 2003 8:43 AM>To: mathgroup@smc.vnet.net>Why does the following code cause and exception? I thought that the>left hand side of := was not evaluated.>>Clear[a, z];>z[x_Integer] := 2;>z[x_] := Throw[11];>a[i_, iUp_?z] := 3;>a[i_Integer, iUp_?z] := 5;>>Hein>Hein,well, your assumption simply is not correct. If several definitios are madeto the same symbol, mathematica tries to bring them into order such thatthere are no definitions shadowed. For this left-hand sides may be partiallyevaluated. See:In[2]:= f::killroy = was here!;In[3]:= z[_] := Message[f::killroy]In[4]:= f[i_, j_?z] := 1In[5]:= f[i_] := 2In[6]:= f[i_, j_] := 3f::killroy: was here!In[7]:= f[i_, Sqrt[4]] := 4f::killroy: was here!In[8]:= f[i_, j_, k_] := 5In[9]:= ?fGlobal`ff[i_, j_?z] := 1f[i_] := 2f[i_, 2] := 4f[i_, j_] := 3f[i_, j_, k_] := 5Above, for line 5, there are no potential conßicts, nothing happens.for line 6, there is a potential conßict of the new definition with thatfor line 7, dito, also observe how Sqrt[4] is evaluated to 2 for theresulting definition. It will be placed before definition of line 6, but notbefore the first definition.for line 8, again there is not potential conßict. If you define instead at line 2: z[_Integer] := ... if you define z[Verbatim[j_]] := ...--Hartmut Wolf ==== I am definihg step-like functionClear[h]h[x_] := 0/;x<0h[x_] := 1/;0<=x<=1h[x_] := 2/;1<=x<=2h[x_] := 3/;2<=x<=3h[x_] := 4/;x>3It works fine:Table[h[x],{x,-1,4,.5}]{0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 4}As I may need more steps, I am trying to do the same in loop:Clear[g]g[x_] := 0/;x<0Do[g[x_] := i/;i-1<=x<=i, {i,3}]g[x_] := 4/;x>3This time no luck:Table[g[x],{x,-1,4,.5}]{0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 4}{0, 0, g[0.], g[0.5], g[1.], g[1.5], g[2.], g[2.5], g[3.], 4, 4}How to do this?Vadim. ==== Hi MathGroup,I'm trying to figure out how to create a function that remembers its values inside a function definition (I want the temporary function to stay hidden in a package eventually. I've tried the followingtest[f_, vars_List] := Module[{v, vPat}, Clear[temp]; vPat = Sequence @@ (Pattern[#, Blank[]] & /@ vars); v = Sequence @@ vars; temp[vPat] := temp[v] = f[v]; ]When I evaluatetest[Sin, {x}]I find that the definition of temp isn't what I want?temptemp[x_] := temp[v$97] = Sin[v$97]What I'd like to get instead istemp[x_] := temp[x] = Sin[x]I've tried putting ReleaseHold around various parts of the assignment but so far haven't found a way to do what I want.Any help will be appreciated.Ken-- Ken SaleGroup Leader / PhysicistRadiation Technology GroupLawrence Livermore National Laboratory(925) 423-0686 ==== > Hi mathgroup,> Whenever a graphic command is executed in a notebook> the graph is drawn in an area of fixed dimensions.> this area is a little too small for a good view,> especially when you have a number of plots with> varying parameters, as in the case of solution of> differential equations. Is there a way of enlarging> the graph? I would appreciate if DAVID PARK also> responds to this. > There is an option ImageSize->{xpixels,ypixels} available as an option to all graphics. The other location to change is in the Preferences where there is a graphics option ImageSize.I hope that helpsNigel King ==== > ComplexGraphics[primitives : {___}, opts___] :=> Draw2D[primitives,> opts,> AspectRatio -> Automatic,> Frame -> True,> FrameTicks -> False,> Axes -> True,> AxesOrigin -> {0, 0},> AxesStyle -> Gray,> ImageSize -> 500> ]> That saves a lot of typing with each piece of graphics.I think you could also do this with myOptions> = Sequence[ Frame -> True, FrameTicks -> False, Axes -> True, AxesOrigin -> {0, 0}, AxesStyle -> Gray, ImageSize -> 500] SetOptions[Plot,myOptions]at the beginning of your notebook. Or, leave out the SetOptions and write Plot etc commands in the form Plot[-------,myOptions]Right? (Latter choice would allow you to have several different sets of options for different kinds of plots.)-- Power tends to corrupt. Absolute power corrupts absolutely. Lord Acton (1834-1902)Dependence on advertising tends to corrupt. Total dependence on advertising corrupts totally. (today's equivalent) ==== I just obtained MathematicaLink for EXCEL and everything seems to beworking as expected except that I can't get Mathematica functions thatI define in M-Code shhets to work. I reviewed the examples providedand:1. Name a sheet M-Code2. Defined a function Likelihood using Mathematica notation3. Tried using the function in the main spreadsheet with the followingcode: =Math(Likelihood[#1,#2,#3],j40,a40:h40,k40:r40) where Likelihoodis the function defined in the M-Code sheet. I also loaded thepackage with the function that is part of the definition ofLikelihood.Assitance would be greatly appreciated.LarryReply-To: kuska@informatik.uni-leipzig.de ==== Hi,the question is how to avoid the font enbedding.It's done by default and no ConversionOptions documentthis and since the options itself are stringsthere is no way to find out what the option maybe. Jens> Hi,> what is the way to export graphics to eps files with embedding the> characters?> I heard this is now finaly possible in Mathematica 4.2.1.> Daniel Nettels ==== Hi,I'm sure that questions like this have been asked/answered before, butI'm not sure what keywords to search on to find them... some obviouscandidates didn't get me anywhere...Take, for example, f(x)= (x-3)^2 - 1I'd greatly appreciate seeing the Mathematica code that does thefollowing:(a) Plots the parabola itself (duh).(b) Does so on a a gridded piece of graph paper, with the axessubstantially darker than the rest of the grid.(c) Both x and y axes are numbered at the units: 0, +-1, ..., +-10.The numbers should be to the left of the y axis, and below the x axis.The origin doesn't have to be labelled, if it's ugly, or too hard.(d) The y axis is labelled y at the top of the graph, x axis islabelled x on the right.(e) Puts little arrows on the 4 tips of the axes (signifying that theycontinue arbitrarily far).(f) The following points are explicitly represented withreasonable-sized dots: (0,8), (2, 0), (3,-1), (4,0), and (6,8).(g) It would be nice, but not essential, if the tips of the parabolaitself had little arrows (again signifying that it continues upwardwith increasing abs(x) values.Sorry for all the conditions - just trying to be somewhat preciseabout what I meant by graphs like those in textbooks. Once I get thecode for this, I'm sure I can modify it to other similar tasks...Can all these desiderata be obtained in *one* Mathematica graph? Or isthere another graphics/graphing program that is better-suited to suchtasks?cdjReply-To: robert.pigeon@videotron.ca ==== Mathematica 4.2 can import FITS files as you all know. It will importfiles if the extension is FITS or FIT. But I have a full CD with CCDpictures with an extension FTS. Those pictures where taken with CCD camerasand telescopes and are part of a CD included in a book about AstronomicalImaging. I want to Import those pictures in Mathematica to do some processing. If Inot compatible. If I change the extension from FTS to FITS and try toHeader of the files are typical FITS Header. Is there a way to Import those pictures???Robert ==== >Is there a place where I can get Mathematica notebooks that demonstrate 3-D>graphics? I am running Mathmatica 4.0 and wanted to see an entire range of>surfaces, 3-D Art, etc.>There are many places, but here's a good place to start-------------------------------------------------------- ------Omega ConsultingThe final answer to your Mathematica needshttp://omegaconsultinggroup.com ==== Kevin & Jens,The question was not how to write an efficient general-purpose differential equation solver. It was a simpler question about how to deploy the basic step in an explicit multistep iterative method (with fixed stepsize). Adams-Bashforth just seemed like a good, simple example to use. Perhaps I should have phrased things more clearly.Anyway, so far Hartmut Wolf's technique is about twice as fast as what I had been doing and twice as fast as the technique presented by Omega Consulting.----Selwyn Hollis> I agree with Jens comment. Also why just the predictor? If you are > going to> do it this way, I would use the Moulton corrector along with it. Much > of the> recent literature on non-stiff ODE solvers seems to be moving away from> predictor-corrector methods and suggesting that Runge-Kutta methods be > used> for moderate accuracy/fast derivative function problems, and > extrapolation> methods such as Bulirsch-Stoer for high accuracy. Based on my own> experience, I concur with this logic.>> Kevin> I'd like to throw this out as a challenge to the group: What's the >> most>> efficient way to implement in Mathematica an explicit multistep>> iterative method such as, say, the 4-step Adams-Bashforth method for>> solving y' = f(t,y):>> y[k+1]:= y[k] + (h/24)*(55*f[k] - 59*f[k-1] + 37*f[k-2] - 9*f[k-3])>> where y[0], y[1], y[2], y[3] are given, and f[i] denotes f[t0 +i*h,>> y[i]]. The desired output would be the list>> {y[0], y[1], y[2], ... , y[n]}.>> A suitable toy problem is>> y' = -2t*y^2, y(0) = 1,>> with h = 0.01, n = 1000 (?), and the starting values taken from the>> exact solution y = 1/(1+t^2):>> y[0]=1, y[1] = 0.9999, y[2] = 0.9996, y[3] = .999101.>> ------->> Selwyn Hollis>Reply-To: robert.pigeon@videotron.ca ==== Good day, How can I export a variable from inside a Package-Module to a notebook ??Here's what I'm trying to do:In a Package I create a Module:Begin[`Private`]line[im_] := Module[{i}, For[i=1, i <= 1024, i++, line[i] = im[[1,2,i]] ]; ];Where im is a FITS image Imported with Verbose-> True.Now, I want to have access to line[] in the notebook from where I calledline[]. It is not available, I get:in>> line[1]out >> line[1]and not the list from the Module.But if I program the same Module in the notebook, then I have access toline[].in >> line[1]out >> the first line of the image imported as a list.I know that it is probably a basic question on Packages and Module... but Iread THE book and two other books on programming Mathematica and there isthings that I still do not understand :)RobertReply-To: kuska@informatik.uni-leipzig.de ==== Hi,parallel commands are usualy slower than serial ones,because you have the overhead for process communication.For your parallel dot command you have to transfer twodoubles (16 Byte) to do a multiplication and a additionwith double speed. I don't know you CPU type and speed. I would expect, that you CPU can doan addition and a multiplication in 2-4 CPU-cylcesand this will need much less time than the transferof 16 Byte via MathLink. Since the time for sending the data is much larger thanthe speed gain by the parallel execution, your parallelcommand must be much slower than the serial version.General it is very difficult to design analgorithm that is faster executed parallel than on aserial machine. The critical question is how fast can thecomunicatione be and how can I reduce the data exchangebecause a communication via shared memory, pipes or TCP/IPis typical 100-10000 slower than the data exchange on thesystem bus on the mainboard.To get a speed gain, you have to increase the operationcount that every CPU does on the data. It must be much lager than a simple addition/multiplication.Say 5000-10000 CPU cycles per byte - than and only than you willsee a speed gain.Don't expect, that any of your parallel commandsis faster than the serial execution. It is afairy-tale that parallel computing is fasterthan serial execution. The exceptions of thisrule need special algorithms and very carefull programming. Jens> Dear All,> I appreciate any response on the following problem:> It appears that ParrallelDot function, which is a> part of Parallel Kit, works two orders of magnitude> slower on my two processor machine than Dot. Below> is the commands used to evaluate dot product in pa-> rallel. I am not sure that the command> ExportEnvironment[TestMtrx];> is necessary in that case (though it doesn't do any> harm). It takes 6 seconds to evaluate> Dot[TestMtrx,TestMtrx]> and about half an hour to evaluate> ParallelDot[TestMtrx,TestMtrx]> Needs[Parallel`Parallel`]> Needs[Parallel`Commands`]> ProcIDTable = Table[LaunchSlave[localhost,$mathkernel],{2}];> TestMtrx = Table[Random[Real,{-1,1}],{1000},{1000}];> ExportEnvironment[TestMtrx];> TestDot = ParallelDot[TestMtrx,TestMtrx]> I have plenty of RAM (4GB), thus this problem can't> be caused by kernels competing for memory space...> --> Denis Areshkin> (919) 513-2424 (office)> (919) 835-1650 (home)Reply-To: kuska@informatik.uni-leipzig.de ==== Hi,and what has this to do with Mathematica ?MikTeX's DVI-previewer Yap need a PostScript interpretorto show you a preview of the included PostScript images.If you don't have ghostscript installed, you will not seeInstall ghostscript http://www.ghostscript.com/you need it anyway to print the files on annon-PostScript printer. Jens> Hi,> I am a new user of Mathematica and I have currently encountered a> problem. In fact, I plotted a graph which contains arrows ( for this I> called up on the to Tex as an EPS file and compiled in Miktex, when activating the DVI, I am> Is there a way to solve the problem?> William L.97pez P.8erez> Departamento de Matem.87ticas y F.92sica> Universidad del Norte> _________________________________> Visita nuestro sitio Web en: http://uninorte.edu.coReply-To: kuska@informatik.uni-leipzig.de ==== Hi,> I am defining a function:> h[x_]:=0/;x<0> h[x_]:=x/;x>=0> When I try to plot the function:> Plot[h[x],{x,-1,1}]> I see that it's defined as h[x_]:=x on all values, not only positive ones.> What am I missing here?your eyeglasses ?Clear[h] or start a fresh Mathematica kernel or tryh[x_] := UnitStep[x]*xAnyway you definition above is correct and you can check itwithDownValues[h] Jens ==== Im not sure, and i cannot reach any copy of mathematica here, but i thinkit'll work if you place the condition into the argument list like this:h[x_ /; x<0] := 0h[x_ /; x>=0] := xPhaul> I am defining a function:> h[x_]:=0/;x<0> h[x_]:=x/;x>=0>> When I try to plot the function:> Plot[h[x],{x,-1,1}]>> I see that it's defined as h[x_]:=x on all values, not only positive ones.> What am I missing here?>> Vadim.>> ==== Vadim,I don't obtain that result, either in a Plot or in a Table.h[x_] := 0 /; x < 0h[x_] := x /; x >= 0Table[h[x], {x, -1, 1, 0.25}]{0, 0, 0, 0, 0., 0.25, 0.5, 0.75, 1.}David Parkdjmp@earthlink.nethttp://home.earthlink.net/~djmp/ Vadim. ==== I could not reproduce your problem in my machine. It plots h[x] as itshould. Perhaps you can try inserting semicolons after each line?Tomas GarzaMexico City----- Original Message -----> I see that it's defined as h[x_]:=x on all values, not only positive ones.> What am I missing here?>> Vadim.>> ==== 1. With Format > Word Wrapping > Don't, it frequently wraps when thetext (cursor) is less than halfway across the screen. Why does thishappen? I haven't changed any of the screen behaviors so far as Iknow.2. Mathematica has this helpful feature where even in a Text cell when youintroduce certain characters, suddenly all alignments go screwy as ifto warn you that , for example, a right paren is lacking. It also doesthis at times when I can't see what it's trying to tell me. I hatethis feature and want to depend on myself for format correctness. Isthere a way to get rid of it?3. Why does the appearance of for example a product symbol (with lowerand upper limits) depend on whether the cell is Text or Input? Thesymbol in a text cell is tiny, ugly, and kind of useless. Can I makeit (and the others) look like it does in an Input cell? I know aboutmaking Input cells not evalatable, but maybe there is another way.Steve Gray ==== I think I've basically answered my own question, so here was/is the answer(just replace all instances of Sign(x) by Abs(x)/x) and I think I've founda rationalization of the denominator which obeys the parity. I'll see ifMathematica allows for further Simplification of this form later on (andafter it hopefully does do so, run my test values through it).Sample Sectuples (and should return the same sets of at most four orderedpairs for all sectuples of the form: (x+Iy)*[a,b,h,g,f,c] under thisvector/scalar functional arithmetic) are:{[2,-5/2,-3,-1/2,-4/2,6], [13,-9,37,1,7,-2], [12,-23/2,10,-25/2,13,-14],[55,-30,39,-40,-24,-464], [1,-Sqrt[3],3,3,-2,5], [9,4,-3,2,5,1]}note: not all of the sectuple examples abide with the rules (theinterested reader to find out which ones don't, and, once the reader getsthe hang of using real-only sectuples, I'd be interested in seeing whichif any complex-valued sectuple-samples he can construct, as I do needsome. I personally haven't yet had the time to run the sample sectuplesthrough from Start at: equation 1 -> equation 3 to see that things will bereturned in the same order, but I do know that 1->2, even when trying tomodify wth Abs signs, was not co-operating for all sectuples.I used a combination of TargetFunctions, Extension, Cancel, Simplify,Apart, Together, Expand, TrigToExp, etc and their specific options to getfrom 1->3, but if someone knows of a quicker pattern to get from 1 -> 3 ->2, I'm interested in listening...{{{{-((b*g)/(a*b - h^2)) + (f*h)/(a*b - h^2) + (a*E^(I/2*Arg[-((a*(-(b*c)+ f^2) + b*g^2 + h*(-2*f*g + c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(a*b- h^2)^2) - (b*E^(I/2*Arg[-((a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))*(-a + b +Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 +4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) + (E^(I/2*Arg[-((a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) + h^3]^2)*Sqrt[(a - b)^2 + 4*h^2]*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c)+ f^2) + b*g^2 + h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(-(a*b) + h^2)^2)}, {-((a*f)/(a*b - h^2)) + (g*h)/(a*b -h^2) +(E^(I/2*Arg[-((a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(-a + b +Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 +4*h^2]]])/(Sqrt[2]*h*(-(a*b) + h^2)^2)}}}, {{{-((b*g)/(a*b - h^2)) +(f*h)/(a*b - h^2) - (a*E^(I/2*Arg[-((a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) +h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]-2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2]]*Sqrt[Abs[-a + b +Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) + (b*E^(I/2*Arg[-((a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(-a + b + Sqrt[(a -b)^2 + 4*h^2]))]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c)+ f^2) + b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) +b*g^2 + h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 +h*(-2*f*g + c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 +4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) - (E^(I/2*Arg[-((a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g+ c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) +h^3]^2)*Sqrt[(a - b)^2 + 4*h^2]*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) +b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 +h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(-(a*b) +h^2)^2)}, {-((a*f)/(a*b - h^2)) + (g*h)/(a*b - h^2) -(E^(I/2*Arg[-((a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(-a + b +Sqrt[(a - b)^2 + 4*h^2]))]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 +h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 +h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[-a + b + Sqrt[(a - b)^2 + 4*h^2]]])/(Sqrt[2]*h*(-(a*b) + h^2)^2)}}},{{{-((b*g)/(a*b - h^2)) + (f*h)/(a*b - h^2) + (a*E^(I/2*Arg[(a*(-(b*c) +f^2) + b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 +h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 +h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) - (b*E^(I/2*Arg[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h)*(a - b + Sqrt[(a - b)^2 + 4*h^2])]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h)^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) - (E^(I/2*Arg[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])]*Sign[-(a*b*h) + h^3]^2)*Sqrt[(a - b)^2 + 4*h^2]*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 +4*h^2]]])/(2*Sqrt[2]*h^2*(-(a*b) + h^2)^2)}, {-((a*f)/(a*b - h^2)) +(g*h)/(a*b - h^2) + (E^(I/2*Arg[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 +4*h^2])]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) +b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 + 4*h^2]]])/(Sqrt[2]*h*(-(a*b)+ h^2)^2)}}}, {{{-((b*g)/(a*b - h^2)) + (f*h)/(a*b - h^2) - (a*E^(I/2*Arg[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2+ 4*h^2])]*Sign[-(a*b*h) + h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 +4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) + (b*E^(I/2*Arg[(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g+ c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])]*Sign[-(a*b*h)+ h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 +4*h^2]]])/(2*Sqrt[2]*h^2*(a*b - h^2)^2) + (E^(I/2*Arg[(a*(-(b*c) + f^2) +b*g^2 + h*(-2*f*g+ c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])]*Sign[-(a*b*h)+ h^3]^2)*Sqrt[(a - b)^2 + 4*h^2]*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g +c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 + 4*h^2]]])/(2*Sqrt[2]*h^2*(-(a*b) + h^2)^2)}, {-((a*f)/(a*b - h^2))+ (g*h)/(a*b - h^2) - (E^(I/2*Arg[(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])]*Sign[-(a*b*h)+ h^3]^2)*Sqrt[a^2*b^2*h^2*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2] - 2*a*b*h^4*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2] + h^6*Sqrt[(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))^2]]*Sqrt[Abs[a - b + Sqrt[(a - b)^2 + 4*h^2]]])/(Sqrt[2]*h*(-(a*b)+ h^2)^2)}}}}> I am given a set of four ordered pairs of formulae of six variables:{{{{((-(b*g) + f*h)*(a*b - h^2)*(-a + b + Sqrt[(a - b)^2 + 4*h^2]) +Sqrt[2]*Sqrt[-((-(a*b*h) + h^3)^2*(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g+ c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))])/((-(a*b) + h^2)^2*(-a + b+ Sqrt[(a - b)^2 + 4*h^2]))},{(a*f - g*h)/(-(a*b) + h^2) + Sqrt[-((-(a*b*h)+ h^3)^2*(a*(-(b*c) + f^2) + b*g^2 + h*(-2*f*g + c*h))*(-a + b+ Sqrt[(a - b)^2 + 4*h^2]))]/(Sqrt[2]*h*(-(a*b) + h^2)^2)}}},{{{(-((b*g - f*h)*(a*b - h^2)*(-a + b + Sqrt[(a - b)^2+ 4*h^2])) - Sqrt[2]*Sqrt[-((-(a*b*h) + h^3)^2*(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))])/((-(a*b)+ h^2)^2*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))}, {-(2*h*(-(a*f)+ g*h)*(-(a*b) + h^2) + Sqrt[2]*Sqrt[-((-(a*b*h) + h^3)^2*(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))*(-a + b + Sqrt[(a - b)^2 + 4*h^2]))])/(2*h*(-(a*b) + h^2)^2)}}},{{{(-((b*g - f*h)*(a*b - h^2)*(a - b+ Sqrt[(a - b)^2 + 4*h^2])) - Sqrt[2]*Sqrt[(-(a*b*h) + h^3)^2*(a*(-(b*c)+ f^2) + b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])])/((-(a*b) + h^2)^2*(a - b + Sqrt[(a - b)^2 + 4*h^2]))}, {(a*f - g*h)/(-(a*b) + h^2) + Sqrt[(-(a*b*h) + h^3)^2*(a*(-(b*c) + f^2) + b*g^2+ h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])]/(Sqrt[2]*h*(-(a*b) + h^2)^2)}}},{{{((-(b*g) + f*h)*(a*b - h^2)*(a - b+ Sqrt[(a - b)^2 + 4*h^2]) + Sqrt[2]*Sqrt[(-(a*b*h) + h^3)^2*(a*(-(b*c)+ f^2) + b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])])/((-(a*b) + h^2)^2*(a - b + Sqrt[(a - b)^2 + 4*h^2]))},{-(2*h*(-(a*f)+ g*h)*(-(a*b) + h^2) + Sqrt[2]*Sqrt[(-(a*b*h) + h^3)^2*(a*(-(b*c) + f^2)+ b*g^2 + h*(-2*f*g + c*h))*(a - b + Sqrt[(a - b)^2 + 4*h^2])])/(2*h*(-(a*b) + h^2)^2)}}}}> I refer to the six variables as a (complex valued) sectuple, with> interesting cases usually occurring with real values, and such that each> of:>> i) hh-ab=/=0 (Cases interested in: replace Ô=/=' with Ô<', Ô>',> respectively),> ii) (abc-2fgh-aff-bgg-chh)/(ab-hh)=/=0 (Cases interested in: replace> Ô=/=' with Ô<', Ô>', respectively),> and,> iii) a=/=b (Cases interested in: replace Ô=/=' with Ô<', Ô>',> respectively)>> occur (ie, cases i, ii, iii hold simultaneously, but the subcases can> (and might need to) be broken down further).>> I would like to get the equations into the following form, but also> respecting the complex-valued arithmetic (so that when I later> define the second as a general sectuple function, it should produce some> real and some complex values when assigned real-valued sectuples):>Cases[Run seperate cases of the interesting If conditions{{{{[Alpha] + (Sqrt[Abs[[Zeta]]]*Sqrt[Abs[a - b + Sqrt[Abs[(a - b)^2+ 4*h^2]]]])/(Sqrt[2]*(a*b - h^2))},{[Beta]+ (Sqrt[Abs[[Zeta]]]*Sqrt[Abs[-a + b + Sqrt[Abs[(a - b)^2 +4*h^2]]]])/(Sqrt[2]*(a*b - h^2))}}}, {{{[Alpha] +(Sqrt[Abs[[Zeta]]]*Sqrt[Abs[a - b + Sqrt[Abs[(a - b)^2 +4*h^2]]]])/(Sqrt[2]*(-(a*b) + h^2))},{-[Beta] -(Sqrt[Abs[[Zeta]]]*Sqrt[Abs[-a + b + Sqrt[Abs[(a - b)^2+ 4*h^2]]]])/(Sqrt[2]*(-(a*b) + h^2))}}},{{{[Alpha] - (Sqrt[Abs[[Zeta]]]*Sqrt[Abs[-a + b + Sqrt[Abs[(a - b)^2+ 4*h^2]]]])/(Sqrt[2]*(-(a*b) + h^2))},{[Beta]+ (Sqrt[Abs[[Zeta]]]*Sqrt[Abs[-a + b - Sqrt[Abs[(a - b)^2 +4*h^2]]]])/(Sqrt[2]*(-(a*b) + h^2))}}}, {{{[Alpha]+ (Sqrt[Abs[[Zeta]]]*Sqrt[Abs[a - b - Sqrt[Abs[(a - b)^2 + 4*h^2]]]])/(Sqrt[2]*(-(a*b) + h^2))}, {-[Beta] - (Sqrt[Abs[[Zeta]]]*Sqrt[Abs[-a+ b -Sqrt[Abs[(a - b)^2 + 4*h^2]]]])/(Sqrt[2]*(-(a*b) + h^2))}}}},print(particular case set, formula style for the case set)], whereabbreviations of [Alpha] -> (-(b*g) + f*h)/(a*b - h^2), [Beta] -> (-(a*f) + g*h)/(a*b - h^2), [Zeta] -> Det[{{a, h, g}, {h, b, f}, {g, f, c}}] can occur.> In some cases, when multiplying across square roots, absolute value> arithmetic need be enforced (I would prefer to not introduce trig and> exp arithmetic rules using exptotrig and trigtoexp). In fact, when> running a few tests on these equations, I had found that by changing a> few Abs signs on sqrts, that I could reproduce identical results between> the two formulae.>> So, the main question is then: if Mathematica's root command likes to> take a certain parity in computing the nth root (n integer) of value^k,> 0 rationalize the denominator, can I ensure the list's set(value)[k] is> returned in the same order when using formula 1 and formula 2,> regardless of whether value is left in the generalized equation form> (the case conditions can be added in here, but I would prefer to see as> few as possible, and to keep further subcase breakdowns as simple as> possible) or in the numerical list of values form?>> How can I get Mathematica to return all possible formulae values, given> that I've not yet chosen a sectuple?>> [ Can I somehow define p/m the plus or minus typographical symbol, as> found in the button toolkits and m/p to have the same rules of addition> and subtraction, multiplication, division, root extration, raising of> powers, etc that any other regular formula would have if somehow just> b) to keep parity, and such that replace and/or simplify could simplify> k=p/m(a,b), in the same way that replace replaces (a+b)->k?)? I don't> fully understand how all of the abbreviating rules of Hold, etc can work> for me, and would rather not have to override operator definitions to> make them look too concise - means: be thorough; I don't use pattern> matching rules too often if I can get away with it, mainly since I find> this part of the Mathematica book harder to understand. ]>> I would like to generate a more effecient coding scheme than just> writing a few nested for(j,k,l=1 to 2 do (-1^j,k,l)) loops to switch the> signs whenever I come across a new formula possibility.>> The following idea for complex numbers scaled to the unit circle would> work in a similar fashion, but for my formulae (but for unscaled> numbers):>> !((tFor[k = 1, k < 30, {a_k := FullSimplify[@(((((1 +> I))/@2) )^(k/2))%3 ((((-I) - @3)/2))^3],> Print[a_k]}, (++k)]))>> System specifics: Pentium II 350 Mhz, 64 Meg Ram, Window 98, Mathematica> 3.0, and sometimes get Out of Memory. Exiting. returns when trying to> further manipulate these and similar formulae. Upgrade of> software/hardware is not an option for me at this time.>> Kai G. GauerThe following ideas occurred to me only after searching the version 4'sdocumentation centre and finding out more about options such asTargetFunctions, Extension, Cancel, Simplify, Apart, Together, Expand,FullSimplify, TrigToExp, ExcludedForms, etc and which options can be usedwith each other when doing polynomial arithmetic. Incidently, does anyoneknow of any simple pattern matching code for building 3-by-1terms_sometimes_scrambled((x^2-6x+9)-4y^2)=+/-((x-3), 2y) with (you figureout what duty the +/- operator should do in general for this case), and2-by-2 (see any Gr 10 math text; just check for the right section)multinomial factoring arithmetic rules (by this, I would even later onmean that the coeffecients can be picked symbolically, and not just fixedas numbers right away), as well as also showing what Simplify'spattern-matching could possibly be seeking in each step-by-step-by-step ofa Complete_The_Square simplification operation into FullSimplify etaliad for version 3 (I'd personally have been much happier using only anoption similar to ExcludedForms, but which instead could only chase afterlook harder for this type of idea before I consider an upgrade to >v4.2 -note that this pseudo-bug could possibly affect my decision to choose anew favourite programming language, mind you - and it still isMathematica) ==== Solution required is for y''= f(x,y,y') ; (typo) ; ==== Hi Nathan,tryShow[ListPlot[data,DisplayFunction->Identity], Plot[f[x],{x,0,Xo},DisplayFunction->Identity], DisplayFunction->$DisplayFunction]Daniel Nettels>The list operations have been very useful.>>Here's a pet peeve. Often when I combine several graphics objects with>the show command I get a bunch of extraneous plots. Suppose I have a list>of {x,y} pairs (named data) and a fit function f[x] and I want to show>them together. The easiest way to do this is with the command,>>Show[ListPlot[data],Plot[f[x],{x,0,Xo}]>>When I execute this I get 3 plots, ListPlot[data], the Plot[f[x]], and>then the tro combined. How can I have the front end suppress the first>two plots? (this error is especially annoying when I'm plotting 7 or 8>lists together)>>Nathan Moore> > ==== Perhaps this is what you want:(Replace (*****) with your function and list)Show[Plot[ (*****),DisplayFunction->Identity],ListPlot[(********), DisplayFunction->Identity],DisplayFunction->$DisplayFunction] Phaul ==== faults with Mandrake 9.1I don't know how to solve this problem but it sure sux!sss. Minh> I am having segmentation fault at startup with Mathematica 4.2.1 (and 4.2) Minh> start just the kernel. It occurs with both the statically and the Minh> dynamically linked versions. The same install works fine when I boot Minh> up using Red Hat 8.0. Minh> Mathematica 4.1 runs but the display seem to have a big font encoding mess. Minh> At last one other Mandrake user reports font issues with 4.1. Minh> Anybody else is experiencing these issues? Minh> Minh.-- odium veritas parit ==== As for question 2Sorry, I lost a word in question 2:2.Are the two types Word& Record have different meanings?----- Original Message -----cost associated with Import.>> To give a specific example, suppose you had a spreadsheet file save as atab deliminated file that contained a mixture of both numeric andnon-numeric data. Then>> Import[filename, Table] would read all of the data in correctlymaintaining the data structure. Numeric data would be read in as numbersready to use in further computation. OTOH,>> ReadList[filename, Number, RecordLists->True]>> would generate errors and fail when the non-numeric data was encountered.The errors could be avoided with>> ReadList[filename, Word, RecordLists->True]>> but now all of the data would be type String and would not be ready forfurther computations without additional programming.>> If the file had the same format but contained only numeric data,>> Import[filename,Table] and> ReadList[filename, Number, RecordLists->True]>> would have identical results but ReadList would execute faster.>>2.Are the two types Word and have different meanings?>> Not as far as I know.> ==== (* this clumsy program does something similiar to what you're asking.The stereo effect is produced by slightly crossing your eyes *)Table[ Show[ GraphicsArray[{ ParametricPlot3D[Evaluate[ Table[{Sin[ theta+mu] Cos[theta+mu],-Sin[ theta-mu] Cos[ theta-mu],mu+theta}, {mu,1,Pi,1/32}]], {theta,omega-1/2,omega}, AspectRatio->Automatic, Boxed-> False,Axes->False, PlotPoints->100,DisplayFunction->Identity, PlotRange->All, ViewPoint-> {1,-1.3,0} ], ParametricPlot3D[Evaluate[ Table[{Sin[ theta+mu] Cos[ theta+mu],-Sin[ theta-mu] Cos[ theta-mu],mu+theta}, {mu,1,Pi,1/32}]], {theta,omega-1/2,omega}, AspectRatio->Automatic, Boxed-> False,Axes->False, PlotPoints->100,DisplayFunction->Identity, PlotRange->All, ViewPoint-> {.8,-1.3,0} ]}, GraphicsSpacing -> .001]], {omega,Pi,2Pi,Pi/24}]> I have a set of vectors eg{{12,21,22},{21,24,87},{-16,3,5}..........}} I> will like to plot the stereographic projections of these. can anyone help?>---= 19 East/West-Coast Specialized Servers - Total Privacy via Encryption =--- ==== yaw,What do you mean by stereographic projection in this case? I thought thata stereographic projection was from a sphere, usually a unit sphere, to aplane. Your vectors do not lie on a single sphere. One can definitely dostereographic projections with Mathematica but we need more information.David Parkdjmp@earthlink.nethttp://home.earthlink.net/~djmp/Sender: steve@smc.vnet.netApproved: Steven M. Christensen , Moderator ==== > Hi,>> I am looking for an efficient (read fast) way to generate the set of all> combinations of na elements drawn with replacement from a set of nr> distinct elements. The number of these, of course is>> In[53]:=> numcombs[na_,nr_]:=((nr+1)+na-1)!/(na!*((nr+1)-1)!)>> In[106]:=> numcombs[3,4]>> Out[106]=> 35>> Just for illustration, here's a super-inefficient example that generates> all subsets of the right size, then pares them down to just the unique> combinations. I'm assuming that the set of elements is {0,1,2,...,nr-1},> and using the KSubsets function from the Combinatorica package.>> In[111]:=> tcombs[na_,nr_]:=KSubsets[Flatten[Table[Range[0,nr],{na}]],na ]>> In[112]:=> temp1=tcombs[3,4];> temp2=Union[Map[Sort[#]&,temp1]]> Length[temp2]>> Out[113]=> {{0,0,0},{0,0,1},{0,0,2},{0,0,3},{0,0,4},{0,1,1},{0,1,2},{ 0,1,3},{> 0,1,4},{0,2,2},{0,2,3},{0,2,4},{0,3,3},{0,3,4},{0,4,4},{1,1,1 },{> 1,1,2},{1,1,3},{1,1,4},{1,2,2},{1,2,3},{1,2,4},{1,3,3},{1,3,4 },{> 1,4,4},{2,2,2},{2,2,3},{2,2,4},{2,3,3},{2,3,4},{2,4,4},{3,3,3 },{> 3,3,4},{3,4,4},{4,4,4}}>> Out[114]=> 35>> This gets highly unwieldy as na and nr increase. Any suggestions?> Gareth Russell> Columbia UniversityYou seem to have confused nr and nr + 1. The correct formula should benumcombs[na_,nr_]:=(nr+na-1)!/(na!*(nr-1)!)which is just Binomial[nr + na - 1, nr]. (Among nr + na - 1 slots for nrdots and na - 1 dividers, choose where the nr dots go.) For your example,take na = 3 and nr = 5 (your five distinct elements are {0, 1, 2, 3, 4}),yielding Binomial[7, 3] = 35.Here's a more efficient way of getting the 35 triples:Flatten[Table[{x1,x2,x3},{x1,0,4},{x2,x1,4},{x3,x2,4} ],2]Rob PrattDepartment of Operations ResearchThe University of North Carolina at Chapel Hillhttp://www.unc.edu/~rpratt/ ==== there is a mistake in my last post. the actualdiscretizaed equation should read as follows eq2 = Table[ D[y[i][t], t] == (y[i + 1][t] - 2y[i][t] + y[i-1][t])/(dx^2),{i, 1, nbins}];but not, eq2 = Table[ D[y[i][t], t] == (y[i + 1][t] - 2y[i][t] + y[i-1][t])/(dx^2) + c y[i][t]^2 - c y[i][t], {i, 1, nbins}];so to reiterate the actual input for the discretizedequation is as below.Apologies for any confusion to those who consideredcommenting.In[13]:=eq1 = D[u, t] == D[u, x, x];xmin = -3; xmax = 3; nbins = 2; npoints = nbins + 1;dx = Abs[(xmax - xmin)/(nbins)];eq2 = Table[ D[y[i][t], t] == (y[i + 1][t] - 2y[i][t] + y[i -1][t])/(dx^2), {i, 1, nbins}];ic = Table[ y[i][0] == N[E^(-x^2) /. {x -> xmin + (i -1)(xmax - xmin)/nbins}], {i, 1, nbins}];vbls = Table[y[i][t], {i, 1, nbins}];list = Join[eq2, ic];NDSolve[list, vbls, {t, 0, 20}]NDSolve::ndnum: Encountered non-numerical value fora derivative at t == (8.761068570442811`*^199Out[19]={{y[1][t] -> InterpolatingFunction[{{0., 0.}},<>][t], y[2][t] -> InterpolatingFunction[{{0., 0.}},<>][t]}}________________________________________________ __Do you Yahoo!?Yahoo! Tax Center - File online, calculators, forms, and morehttp://platinum.yahoo.com ==== there is a mistake in my last post. the actualdiscretizaed equation should read as follows eq2 = Table[ D[y[i][t], t] == (y[i + 1][t] - 2y[i][t] + y[i-1][t])/(dx^2),{i, 1, nbins}];but not, eq2 = Table[ D[y[i][t], t] == (y[i + 1][t] - 2y[i][t] + y[i-1][t])/(dx^2) + c y[i][t]^2 - c y[i][t], {i, 1, nbins}];so to reiterate the actual input for the discretizedequation is as below.Apologies for any confusion to those who consideredcommenting.In[13]:=eq1 = D[u, t] == D[u, x, x];xmin = -3; xmax = 3; nbins = 2; npoints = nbins + 1;dx = Abs[(xmax - xmin)/(nbins)];eq2 = Table[ D[y[i][t], t] == (y[i + 1][t] - 2y[i][t] + y[i -1][t])/(dx^2), {i, 1, nbins}];ic = Table[ y[i][0] == N[E^(-x^2) /. {x -> xmin + (i -1)(xmax - xmin)/nbins}], {i, 1, nbins}];vbls = Table[y[i][t], {i, 1, nbins}];list = Join[eq2, ic];NDSolve[list, vbls, {t, 0, 20}]NDSolve::ndnum: Encountered non-numerical value fora derivative at t == (8.761068570442811`*^199Out[19]={{y[1][t] -> InterpolatingFunction[{{0., 0.}},<>][t], y[2][t] -> InterpolatingFunction[{{0., 0.}},<>][t]}}________________________________________________ __Do you Yahoo!?Yahoo! Tax Center - File online, calculators, forms, and morehttp://platinum.yahoo.com ==== David Park has a very nice elementary notebook on his website, at URL:http://home.earthlink.net/~djmp/Mathematica.htmlwith his StepByStepEquations.nbwhich is a good place to get started. It helped me out with some thingseasy jump to Mathematica'sf[x_] =:Steven Shippeeshippee@jcs.mil> This is a general question.>> Functions like DSolve will solve an equation, say, DSolve[{y''[x] ==> -2*y[x], y[0] == 0, y'[0] == 1}, y, x] for y or y[x]. However, in my few> months of use of Mathematica, it is very perplexing how it works with y,> y[x], interpolating functions, substitution. It is not clear how to use> the results of things. When to substitute with the /. operator, when> not, when to use Evaluate, when not, how to use the output as an> ordinary function... I have had limited success understanding these> issues with the mathematica book. Does anyone know a source of> information explaining these topics so that when I get an output from> for instance an NDSolve function there's no confusion about how to use> it in various circumstances like Plotting and such? It's perplexing.>> thanks,> Steve Story>> ==== Correction to below and apologies to the group/list:My dyslexia set in, proper syntax for functions would bef[x_] :=not as it was mistyped below.David Park has a very nice elementary notebook on his website, at URL:http://home.earthlink.net/~djmp/Mathematica.htmlwith his StepByStepEquations.nbwhich is a good place to get started. It helped me out with some thingseasy jump to Mathematica'sf[x_] =:Steven Shippeeshippee@jcs.mil> This is a general question.>> Functions like DSolve will solve an equation, say, DSolve[{y''[x] ==> -2*y[x], y[0] == 0, y'[0] == 1}, y, x] for y or y[x]. However, in my few> months of use of Mathematica, it is very perplexing how it works with y,> y[x], interpolating functions, substitution. It is not clear how to use> the results of things. When to substitute with the /. operator, when> not, when to use Evaluate, when not, how to use the output as an> ordinary function... I have had limited success understanding these> issues with the mathematica book. Does anyone know a source of> information explaining these topics so that when I get an output from> for instance an NDSolve function there's no confusion about how to use> it in various circumstances like Plotting and such? It's perplexing.>> thanks,> Steve Story>> ==== > Adding emphasis to the axes draws attention to the axes and away from the >data (parabola and plotted points). Since the only reason for producing a >graph is to display the data, other elements of the graph should help clarify >the data, not draw attention away from the data.First off: thank you (and everyone else) who responded - the responseswere very helpful.Next: thanks for the aesthetic advice, but I was just ticking offfeatures of a graph in a high school text book I was looking at. Iagree that I'm not gonna want all of them, but I just wanted to seethe code for the richest graphic I could think of, and whittle down toreasonableness...cdj ==== > Actually, this is a pretty serious problem. We've been trying to make > Mathematica a standard language for our engineering firm, but I've > struggled for years with developing good documentation standards. The > problem is that I have a couple of people that can program in Mathematica style - > very compact functional form, but the people that don't use Mathematica everyday > can never parse how the functions work.Ditto for us. The oneliners are clever tricks, but they are essentially opaque. A thick one liner can take even a decent (by our standards) Mathematica programmer far too long to understand. I'm a big fan of using typography> (indenting and other visual aids) in programming, but Mathematica makes even those > methods difficult. I'm tempted to ban prefix and postfix notation in > packages because they can make for very opaque code.Another roadblock to those methods is that math typesetting and things like special fonts, font colors, and embedded comments play havoc with Mathematica's package autogeneration capability. It's been that way since version 3. I don't understand why they leave those bugs in. ==== And @@ Thread[Drop[FoldList[#1 + #2 &, 0, list], -1] < list]Bob Hanlon<< list = {2, 3, 7, 15, 31}So check:a. It is in increasing order andb. 3 > 2, 7 > 3+ 2, 15 > 7 + 3 + 2 and 31 > 15 + 7 + 3 + 2,hence the list is super-increasing. >>

==== >does a command or module exist which can test a list of values and>determine if it is a super-increasing list?>A super-increasing list satifies the conditions:>a. the list is in increasing order>b. each element of the list is greater than the sum of it's previous>elements>Example:>list = {2, 3, 7, 15, 31}SuperIncreasingQ[data_List] := And @@ Flatten[{OrderedQ[data], MapThread[OrderedQ[{#1, #2}] &, {Drop[FoldList[Plus, 0, data], -1], data}]}] SuperIncreasingQ[list] TrueReply-To: majort@cox-internet.com ==== superIncreasing[t_List] := Catch[ Fold[If[And @@ Thread[#1 < #2], #2 + #1{1, 0}, Throw[False]] &, {1, 1}First@t, Rest@t]; True]BobbyOn Sat, 5 Apr 2003 04:00:35 -0500 (EST), ßip <ßip_alpha@safebunch.com>> does a command or module exist which can test a list of values and > determine> if it is a super-increasing list?>> A super-increasing list satifies the conditions:>> a. the list is in increasing order> b. each element of the list is greater than the sum of it's previous> elements>> Example:>> list = {2, 3, 7, 15, 31}>> So check:>> a. It is in increasing order and> b. 3 > 2, 7 > 3+ 2, 15 > 7 + 3 + 2 and 31 > 15 + 7 + 3 + 2,>> hence the list is super-increasing.>>-- majort@cox-internet.comBobby R. Treat ==== Vadim,Would this simpler definition work for you?Needs[Graphics`Colors`]f[x_, n_] := Ceiling[n x]/nPlot[{f[x, 3], f[x, 7], f[x, 12]}, {x, 0, 1}, PlotStyle -> {Black, Red, Peacock}];David Parkdjmp@earthlink.nethttp://home.earthlink.net/~djmp/ Plot[{g[x,3],g[x,7],g[x,12]}, {x,0,1}]How to to this?Vadim. ==== g[x_, n_] := Sum[UnitStep[x - k/n], {k, 0, n - 1}]/n;Bob Hanlon<< define it when plotting, likePlot[{g[x,3],g[x,7],g[x,12]}, {x,0,1}]How to to this?Vadim. >>

Reply-To: majort@cox-internet.com ==== g[x_, n_Integer] := Sum[UnitStep[x - k/n]/n, {k, 0, n - 1}]or (simpler, more efficient, and not limited to the unit interval)g[x_, n_Integer] := Ceiling[n x]/nThe first is right-continuous while the second is left-continuous.The function is useful for creating various square waves:Plot[g[x, 24] - g[x, 12], {x, 0, 1}]Plot[g[x, 12] - g[x, 24] + g[x, 48] - g[x, 96], {x, 0, 1}]BobbyOn Sat, 5 Apr 2003 04:00:25 -0500 (EST), Vadim Nagornyi > here is the function that grows on unit interval in 12 steps:>> n=12;> Map[(g[x_]:=#/n/;(#-1)/n<=x<=#/n)&,Range[n]];> Plot[g[x], {x,0,1}]>> Now, changing n in the first line we can get different number of> steps.> Instead, I would like to make n the function parameter: g[x_,n_] and> define it when plotting, like>> Plot[{g[x,3],g[x,7],g[x,12]}, {x,0,1}]>> How to to this?> Vadim.>>-- majort@cox-internet.comBobby R. TreatReply-To: majort@cox-internet.com ==== Here's a fairly general method.ClearAll[f, interval, g]f[n_, i_, x_] := Sin[n*i*x]interval[n_Integer, i_Integer, x_] := interval[n, i] = (i - 1)/n .89.81ó x < i/nClearAll[g]g[n_, x_] := Block[{Which}, Which[Sequence @@ Flatten@({interval[n, #, x], f[ n, #, x]} & /@ Range[0, n - 1]), True, 0]]g[12, x]Timing@Plot[g[12, x], {x, 0, 1}]{0.266 Second, .89»¡Graphics.89»[DownExcl amation]}This plots and evaluates faster:ClearAll[g]g[n_] := g[n] = Function[{x}, Evaluate@Block[{Which}, Which[Sequence @@ Flatten@({interval[n, #, x], f[ n, #, x]} & /@ Range[0, n - 1]), True, 0]]]g[12][x]Timing@Plot[g[12][x], {x, 0, 1}]{0.047 Second, .89»¡Graphics.89»[DownExcla mation]}In both cases, , True, 0 can be deleted if x will always be in one of the intervals.BobbyOn Sat, 05 Apr 2003 13:17:00 -0500, Vadim Nagornyi Dear Bobby,> thank you very much for this nice and elegant solution.> Unfortunately, the problem that I posted is a simpification of what I > really need. I simplified it intentionally in hope to get an idea form > responses and than extent it to the real case.> Looks like I have oversimplified it....> In the real case, the function is not constant on the intervals. Instead, > it is definied by some other function that depends on x , on the n, and > on the interval sequentional number, for example Sin[x n i]. If you know > how to solve the problem in this more general case, I would greatly > appreciate your help.> Vadim.> g[x_, n_Integer] := Sum[UnitStep[x - k/n]/n, {k, 0, n - 1}]>> or (simpler, more efficient, and not limited to the unit interval)>> g[x_, n_Integer] := Ceiling[n x]/n>> The first is right-continuous while the second is left-continuous.>> The function is useful for creating various square waves:>> Plot[g[x, 24] - g[x, 12], {x, 0, 1}]>> Plot[g[x, 12] - g[x, 24] + g[x, 48] - g[x, 96], {x, 0, 1}]>> Bobby>> On Sat, 5 Apr 2003 04:00:25 -0500 (EST), Vadim Nagornyi > here is the function that grows on unit interval in 12 steps:>> n=12;> Map[(g[x_]:=#/n/;(#-1)/n<=x<=#/n)&,Range[n]];> Plot[g[x], {x,0,1}]>> Now, changing n in the first line we can get different number of> steps.> Instead, I would like to make n the function parameter: g[x_,n_] and> define it when plotting, like>> Plot[{g[x,3],g[x,7],g[x,12]}, {x,0,1}]>> How to to this?> Vadim.>-- majort@cox-internet.comBobby R. Treat ==== I have a difficult problem:Given a constant integer X (which may be very large) , you no need to find the value of XandX mod 8 = n1X mod 16 = n2the problem is that find n2 if n1 is know? ==== You can't. All you can say is that either n2=n1 or n2=8+n1.> I have a difficult problem:> Given a constant integer X (which may be very large) , you no need to > find the value of X> and> X mod 8 = n1> X mod 16 = n2> the problem is that find n2 if n1 is know?> ==== > I have a difficult problem:> Given a constant integer X (which may be very large) , you no need to findthe value of X> and> X mod 8 = n1> X mod 16 = n2> the problem is that find n2 if n1 is know?Not so difficult! Suppose you write X = 8 i + (Xmod 8) and X = 16 j + (Xmod 16) then, j = i/2 + (n1 - n2)/16.Since 0 <= n1 < 8, 0 <= n2 < 16 and j must be an integer, it is easilyshown thatfor i even, n2 = n1. Whilst for i odd, n2 = n1+8. Bill ==== >It ought to be simple, I just don't know where to find it: I want to>do a (linear, least square) fit but instead of functions in a variable>I want to use lists of the same length as the data list.Is this what you have in mindIn[1]:=listA=Table[Random[],{10}];listB=Table[Random[],{ 10}];Fit[Transpose[{listA,listB}],{1,x},x]Out[3]= 0.7560816265287248 - 0.26693573953881305*xReply-To: majort@cox-internet.com ==== Here are a couple of ways to do it. In either case, Regress can be replaced with Fit.Known values:n = 10;knowns = Sin@Range@n;Predictor variable lists:a = Array[Random[] &, n];b = Range@n;c = b^2;The simplest thing:Regress[Transpose@{a, b, c, knowns}, {1, x, y, z}, {x, y, z}]A more ßexible method:f = Interpolation[a];g = Interpolation[b];h = Interpolation[c];Regress[knowns, {1, f@x, g@x, h@x}, x]The second method can be easily modified to include other predictor functions:Regress[knowns, {1, f@x, g@x, h@x, Cos@x}, x]BobbyOn Sat, 29 Mar 2003 05:20:26 -0500 (EST), Martin It ought to be simple, I just don't know where to find it:> I want to do a (linear, least square) fit but instead of functions in> a variable I want to use lists of the same length as the data list.>> And by the way, I am still running 4.0>-- majort@cox-internet.comBobby R. Treat ==== I am a researcher in Artificial Intelligence and I have a question aboutgenerating random permutation of a set of numbers. More formal definition:Given a set of N numbers S = {n1, ., nn} how to efficiently and accurately generate P(S) = random_permutation(S)Ex: S = {3,4,12}, P(S) should have a probability equals to 1/3! = 1/6 toreturnone of the following permutations:{(3,4,12)(3,12,4)(4,3,12)(4,12,3)(12,3,4)(12,4,3) }and a complexity equals to O(N). and how to efficiently generate an iterator on the numbers which will bereturned by P(S) ?Ex: S = {3,4,12} P(S) can return any of the permutations describedbelow, butwhat we want here is to get an iterator on the future numbers withoutcreating the full permutation Do you know any algorithm performing this task which is very efficientin terms of quality (each permutationhas the same probability to be generated) and in terms of complexity(minimal number of operationsis necessary to perform this operation n2, n, log n, etc.). If you have any clue or web links where I can find this information, this would be very much appreciated. ==== >Given a set of N numbers S = {n1, ., nn}>>how to efficiently and accurately generate P(S) =>random_permutation(S) Ex: S = {3,4,12}, P(S) should have a probability>equals to 1/3! = 1/6 to return one of the following permutations:>{(3,4,12)(3,12,4)(4,3,12)(4,12,3)(12,3,4)( 12,4,3)} and a complexity>equals to O(N).There are two simple ways to do this in Mathematica eitherPermutations[s][[Random[Integer,Length[s!]]or<< DiscreteMath`Combinatorica`;RandomPermutation[s]I am sure the first method will generate a permutation with the correct probability since it generates all permutations then selects one at random. However, becuase it generates all permutations, it probably isn't the most efficient.I have not gone through the code used to implement RandomPermutation in the package DiscreteMath`Combinatorica` nor have I run any tests. But assuming it is coded correctly the probability of getting a given permutation should be what you desire.Finally, Knuth in Vol 3 of Seminumerical Algorithms discusses this problem starting on page 136 ==== >Finally, Knuth in Vol 3 of Seminumerical Algorithms discusses this>problem starting on page 136Correction. That should be Vol 2 not Vol 3 ==== Hi, I am trying to plot a directional field plot for the DEy'=sin(x-y). The question suggests using a viewing window such as-10=x=10, -10=y=10 I have spent hours and hours trying to get this towork, but I must be doing something wrong. Can anyone please, pleasehelp me with typing the right commands? ==== >I'm wondering whether there's a smart way to do map projections with>mathematica.>I know that mathematica comes along with the package `WorldPlot. So is>there anyway to access the data they're using there? They even got>some different projections options but the point is that I want to do>in on my own.>Has anyone got experience in this?Have you opened the file WorldPlot.m that comes with Mathematica using a text editor or something else that can display ASCII? If you do this you will find you can review the code used to implement each of the functions. Additionally, there is information regarding the sources used to develop this package.As far as accessing the data used, the first line of code after the comments isBeginPackage[Miscellaneous`WorldPlot`,Miscellaneous` WorldNames`, Miscellaneous`WorldData`,Utilities`FilterOptions`]suggesting the file WorldData.m contains the data of interest. And that file contains the comment(* :Source: These data are derived from what was originally a CIA database, released into the public domain by the Freedom of Information Act. I acquired a copy of these data, and rearranged them to the form below. The copy I found was from the Amiga Fish disks, a public-domain distribution of software for the Amiga computer, under the name WorldDataBank. Note that these data (in the original format) are available at higher resolution from this source.*)Looking at the packages that were distributed with Mathematica is a very good way to learn by example many useful techniques.Reply-To: majort@cox-internet.com ==== Here are timings with a binary-valued list:n = 10000;test = Array[Random[Integer] &, n];Timing[gray[test];]Timing[hanlon[test];]Timing[andrzej1[ test];]Timing[fisher[test];]Timing[selwyn[test];]Timing[drbob[ test];]Timing[andrzej2[test];]{36.547*Second, Null}{12.406000000000006*Second, Null}{19.437000000000012*Second, Null}{0.29700000000002547*Second, Null}{3.7819999999999823*Second, Null}{0.07800000000003138*Second, Null}{0.06200000000001182*Second, Null}Neither Ôgray' nor Ôandrzej2' can handle more than two values in a list, and they give different answers in that case, while the others agree. (They all agree on binary lists.)n = 1000;test = Array[Round[3*Random[]] &, n];andrzej1[test] == fisher[test] == selwyn[test] == hanlon[test] == drbob[test]gray[test] == drbob[test]andrzej2[test] == drbob[test]gray[test] == andrzej2[test]TrueFalseFalseFalseHere are timings on a list with 21 different values:n = 10000;test = Array[Round[20Random[]] &, n];Union[test]Timing[hanlon[test];]Timing[andrzej1[test];] Timing[fisher[test];]Timing[selwyn[test];]Timing[drbob[test];] {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}{13.078000000000001*Second, Null}{15.563000000000002*Second, Null}{0.5779999999999959*Second, Null}{2.9849999999999994*Second, Null}{0.07800000000000296*Second, Null}and here are timings with 100 different values:n = 10000;test = Array[Round[99Random[]] &, n];Timing[hanlon[test];]Timing[andrzej1[test];]Timing[fisher[ test];]Timing[selwyn[test];]Timing[drbob[test];]{ 12.969000000000001*Second, Null}{15.765*Second, Null}{2.2039999999999935*Second, Null}{3.6400000000000006*Second, Null}{0.09399999999999409*Second, Null}'fisher' seems badly affected by increasing the number of values.BobbyOn Sun, 30 Mar 2003 08:00:57 +0900, Andrzej Kozlowski If any one is interested in doing performance tests I suggest using my > other function, which I also posted to the Mathgroup. The two functions > were meant to demonstrate the difference between elegance (which I > identify with shortness of code) and efficiency. Here is the efficient > one (the algorithm works only for lists containing just two distinct > symbols):>> f2[l_List] := Module[{mult => Length /@ Split[l], list1,> list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, 1,> Length[mult],> 2}]]]; list2 => FoldList[Plus,> 0, Table[mult[[i]], {i, 2, 2(> Floor[(Length[mult] + 1)/2]) - 1, 2}]];> values = Take[Flatten[Transpose[{list2,> list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], {> mult[[i]]}], {i, 1, Length[mult]}]]]>> æææ I am again gratified for all the prompt, more-than-competent >> solutions to my problem. I'm enclosing a .nb file with all replies >> received so far so you can compare them. I did not do timing because the >> lists I have are relatively short and I don't need to call this function >> very often.>> æ>> Steve Gray>> ----- Original Message ----->> To: stevebg@adelphia.net>> Sent: Saturday, March 29, 2003 4:53 AM>> æ æ Given a list consisting of only two distinct values, such as>> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length>> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position>> 1<=p<=Length[s], look at list s and set g[[p]] to the number of>> elements in s to the left of p which are not equal to s[[p]].>> æ æ In a more general version, which I doæ not need now, s would>> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an>> unusual conjecture in geometry.>> > Andrzej Kozlowski> Yokohama, Japan> http://www.mimuw.edu.pl/~akoz/> http://platon.c.u-tokyo.ac.jp/andrzej/>> ==== For what it's worth, I get a 4X speed-up by not using PrependTo, and a minor improvement by using Block instead of Module within Scan:countdiffs[s_List] := Module[{members, totals, g, j}, members = Union[s]; totals = Count[s, #] & /@ members; j = Length[s]; Scan[Block[{i = First@First@Position[members, #]}, g[j] = j - totals[[i]]; totals[[i]]--; j--] &, Reverse[s]]; Table[g[i], {i, Length[s]}]]But it's still much slower than drBob's brilliantly incomprehensible code :^)---Selwyn> Here are timings with a binary-valued list:>> n = 10000;> test = Array[Random[Integer] &, n];> Timing[gray[test];]> Timing[hanlon[test];]> Timing[andrzej1[test];]> Timing[fisher[test];]> Timing[selwyn[test];]> Timing[drbob[test];]> Timing[andrzej2[test];]>> {36.547*Second, Null}> {12.406000000000006*Second, Null}> {19.437000000000012*Second, Null}> {0.29700000000002547*Second, Null}> {3.7819999999999823*Second, Null}> {0.07800000000003138*Second, Null}> {0.06200000000001182*Second, Null}>> Neither Ôgray' nor Ôandrzej2' can handle more than two values in a > list, and they give different answers in that case, while the others > agree. (They all agree on binary lists.)>> n = 1000;> test = Array[Round[3*Random[]] &, n];> andrzej1[test] == fisher[test] == selwyn[test] == hanlon[test] == > drbob[test]> gray[test] == drbob[test]> andrzej2[test] == drbob[test]> gray[test] == andrzej2[test]>> True> False> False> False>> Here are timings on a list with 21 different values:>> n = 10000;> test = Array[Round[20Random[]] &, n];> Union[test]> Timing[hanlon[test];]> Timing[andrzej1[test];]> Timing[fisher[test];]> Timing[selwyn[test];]> Timing[drbob[test];]>> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, > 20}> {13.078000000000001*Second, Null}> {15.563000000000002*Second, Null}> {0.5779999999999959*Second, Null}> {2.9849999999999994*Second, Null}> {0.07800000000000296*Second, Null}>> and here are timings with 100 different values:>> n = 10000;> test = Array[Round[99Random[]] &, n];> Timing[hanlon[test];]> Timing[andrzej1[test];]> Timing[fisher[test];]> Timing[selwyn[test];]> Timing[drbob[test];]>> {12.969000000000001*Second, Null}> {15.765*Second, Null}> {2.2039999999999935*Second, Null}> {3.6400000000000006*Second, Null}> {0.09399999999999409*Second, Null}>> Ôfisher' seems badly affected by increasing the number of values.>> Bobby>> On Sun, 30 Mar 2003 08:00:57 +0900, Andrzej Kozlowski > If any one is interested in doing performance tests I suggest using >> my other function, which I also posted to the Mathgroup. The two >> functions were meant to demonstrate the difference between elegance >> (which I identify with shortness of code) and efficiency. Here is >> the efficient one (the algorithm works only for lists containing just >> two distinct symbols):>> f2[l_List] := Module[{mult =>> Length /@ Split[l], list1,>> list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, 1,>> Length[mult],>> 2}]]]; list2 =>> FoldList[Plus,>> 0, Table[mult[[i]], {i, 2, 2(>> Floor[(Length[mult] + 1)/2]) - 1, 2}]];>> values = Take[Flatten[Transpose[{list2,>> list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], {>> mult[[i]]}], {i, 1, Length[mult]}]]]> æææ I am again gratified for all the prompt, more-than-competent > solutions to my problem. I'm enclosing a .nb file with all replies > received so far so you can compare them. I did not do timing because > the lists I have are relatively short and I don't need to call this > function very often.> æ> Steve Gray>> ----- Original Message -----> To: stevebg@adelphia.net> Sent: Saturday, March 29, 2003 4:53 AM> æ æ Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> æ æ In a more general version, which I doæ not need now, s would> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an> unusual conjecture in geometry.> Andrzej Kozlowski>> Yokohama, Japan>> http://www.mimuw.edu.pl/~akoz/>> http://platon.c.u-tokyo.ac.jp/andrzej/>> -- > majort@cox-internet.com> Bobby R. TreatReply-To: majort@cox-internet.com ==== I actually think my code is the easiest to understand of them all, but I suppose every programmer thinks that!I had forgotten to time my other code, so here it is:drbob2[s_List] := Block[{count, n = 0}, count[any_] := 0; Rest@FoldList[++n - (++count[#2]) &, Null, s] ](Note that the second argument of FoldList, in both my solutions, is not used.)I timed Selwyn's new solution, and the four best (for more than 2 values) are now:n = 10000;test = Array[Round[99Random[]] &, n];Timing[fisher[test];]Timing[selwyn2[test];]Timing[drbob[ test];]Timing[drbob2[test];]{2.171999999999997*Second, Null}{0.7180000000000035*Second, Null}{0.10999999999999943*Second, Null}{0.17199999999999704*Second, Null}BobbyOn Sun, 30 Mar 2003 11:38:29 -0500, Selwyn Hollis For what it's worth, I get a 4X speed-up by not using PrependTo, and a > minor improvement by using Block instead of Module within Scan:>> countdiffs[s_List] := Module[{members, totals, g, j},> members = Union[s];> totals = Count[s, #] & /@ members;> j = Length[s];> Scan[Block[{i = First@First@Position[members, #]},> g[j] = j - totals[[i]];> totals[[i]]--; j--] &, Reverse[s]];> Table[g[i], {i, Length[s]}]]>> But it's still much slower than drBob's brilliantly incomprehensible code > :^)>> ---> Selwyn> Here are timings with a binary-valued list:>> n = 10000;>> test = Array[Random[Integer] &, n];>> Timing[gray[test];]>> Timing[hanlon[test];]>> Timing[andrzej1[test];]>> Timing[fisher[test];]>> Timing[selwyn[test];]>> Timing[drbob[test];]>> Timing[andrzej2[test];]>> {36.547*Second, Null}>> {12.406000000000006*Second, Null}>> {19.437000000000012*Second, Null}>> {0.29700000000002547*Second, Null}>> {3.7819999999999823*Second, Null}>> {0.07800000000003138*Second, Null}>> {0.06200000000001182*Second, Null}>> Neither Ôgray' nor Ôandrzej2' can handle more than two values in a list, >> and they give different answers in that case, while the others agree. >> (They all agree on binary lists.)>> n = 1000;>> test = Array[Round[3*Random[]] &, n];>> andrzej1[test] == fisher[test] == selwyn[test] == hanlon[test] == >> drbob[test]>> gray[test] == drbob[test]>> andrzej2[test] == drbob[test]>> gray[test] == andrzej2[test]>> True>> False>> False>> False>> Here are timings on a list with 21 different values:>> n = 10000;>> test = Array[Round[20Random[]] &, n];>> Union[test]>> Timing[hanlon[test];]>> Timing[andrzej1[test];]>> Timing[fisher[test];]>> Timing[selwyn[test];]>> Timing[drbob[test];]>> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, >> 20}>> {13.078000000000001*Second, Null}>> {15.563000000000002*Second, Null}>> {0.5779999999999959*Second, Null}>> {2.9849999999999994*Second, Null}>> {0.07800000000000296*Second, Null}>> and here are timings with 100 different values:>> n = 10000;>> test = Array[Round[99Random[]] &, n];>> Timing[hanlon[test];]>> Timing[andrzej1[test];]>> Timing[fisher[test];]>> Timing[selwyn[test];]>> Timing[drbob[test];]>> {12.969000000000001*Second, Null}>> {15.765*Second, Null}>> {2.2039999999999935*Second, Null}>> {3.6400000000000006*Second, Null}>> {0.09399999999999409*Second, Null}>> Ôfisher' seems badly affected by increasing the number of values.>> Bobby>> On Sun, 30 Mar 2003 08:00:57 +0900, Andrzej Kozlowski > If any one is interested in doing performance tests I suggest using my > other function, which I also posted to the Mathgroup. The two functions > were meant to demonstrate the difference between elegance (which I > identify with shortness of code) and efficiency. Here is the efficient > one (the algorithm works only for lists containing just two distinct > symbols):>> f2[l_List] := Module[{mult => Length /@ Split[l], list1,> list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, 1,> Length[mult],> 2}]]]; list2 => FoldList[Plus,> 0, Table[mult[[i]], {i, 2, 2(> Floor[(Length[mult] + 1)/2]) - 1, 2}]];> values = Take[Flatten[Transpose[{list2,> list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], {> mult[[i]]}], {i, 1, Length[mult]}]]]>> æææ I am again gratified for all the prompt, more-than-competent >> solutions to my problem. I'm enclosing a .nb file with all replies >> received so far so you can compare them. I did not do timing because >> the lists I have are relatively short and I don't need to call this >> function very often.>> æ>> Steve Gray>> ----- Original Message ----->> To: stevebg@adelphia.net>> Sent: Saturday, March 29, 2003 4:53 AM>> æ æ Given a list consisting of only two distinct values, such as>> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length>> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position>> 1<=p<=Length[s], look at list s and set g[[p]] to the number of>> elements in s to the left of p which are not equal to s[[p]].>> æ æ In a more general version, which I doæ not need now, s would>> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an>> unusual conjecture in geometry.>> > Andrzej Kozlowski> Yokohama, Japan> http://www.mimuw.edu.pl/~akoz/> http://platon.c.u-tokyo.ac.jp/andrzej/>> -- majort@cox-internet.com>> Bobby R. Treat ==== I agree that Bob's algorithm is the simplest and most natural of all except that his use of FoldList seems to me to be intended to mystify and confuse ;-)In factdrbob3[s_List] := Block[{count, n = 0}, count[any_] := 0; Rest@Map[++n - (++count[#]) &, s] ]does the same thing as drbob2 and is, at least on my machine, slightly faster.As for the algorithm, it is essentially exactly what you would do if you had to solve this problem by hand. You simply count how many times an element in the n-th place has occurred and subtract it from n. The only weakness of this algorithm is that when you get a repetition like {b,a,a...} we know that the number of non a's before the second a is the same as the number of non a's before the first a, so there is no need to count but the algorithm wastes a tiny amount of time on recounting this number again.My algorithm for two distinct values avoids this problem. It exploits the fact that to solve the problem for just two distinct values you only need to know:In[23]:=Length/@Split[{a,b,b,a,a,a,b,a,b,a,a}]Out[23]={ 1,2,3,1,1,1,2}The numbers you see give you the number of repeats of the same value you are going to see in the final list. You can also (here is the point where the difference between two value case and the general case becomes significant) work out what these values are going to be. The number you are going to get in the k-th position, where k is even will be the sum of the numbers in all the odd positions preceding k, and the value you get in the k-t place when k is odd the sum of all the values in the even positions preceding k.Since my code depends on this fact it obviously can't be expected to work with more than 2 values.Andrzej KozlowskiYokohama, Japanhttp://www.mimuw.edu.pl/~akoz/http:// platon.c.u-tokyo.ac.jp/andrzej/> I actually think my code is the easiest to understand of them all, but > I> suppose every programmer thinks that!>> I had forgotten to time my other code, so here it is:>> drbob2[s_List] := Block[{count, n = 0},> count[any_] := 0;> Rest@FoldList[++n - (++count[#2]) &, Null, s]> ]>> (Note that the second argument of FoldList, in both my solutions, is > not> used.)>> I timed Selwyn's new solution, and the four best (for more than 2 > values)> are now:>> n = 10000;> test = Array[Round[99Random[]] &, n];> Timing[fisher[test];]> Timing[selwyn2[test];]> Timing[drbob[test];]> Timing[drbob2[test];]>> {2.171999999999997*Second, Null}> {0.7180000000000035*Second, Null}> {0.10999999999999943*Second, Null}> {0.17199999999999704*Second, Null}>> Bobby>> On Sun, 30 Mar 2003 11:38:29 -0500, Selwyn Hollis > > For what it's worth, I get a 4X speed-up by not using PrependTo, and a>> minor improvement by using Block instead of Module within Scan:>> countdiffs[s_List] := Module[{members, totals, g, j},>> members = Union[s];>> totals = Count[s, #] & /@ members;>> j = Length[s];>> Scan[Block[{i = First@First@Position[members, #]},>> g[j] = j - totals[[i]];>> totals[[i]]--; j--] &, Reverse[s]];>> Table[g[i], {i, Length[s]}]]>> But it's still much slower than drBob's brilliantly incomprehensible >> code>> :^)>> --->> Selwyn> Here are timings with a binary-valued list:>> n = 10000;> test = Array[Random[Integer] &, n];> Timing[gray[test];]> Timing[hanlon[test];]> Timing[andrzej1[test];]> Timing[fisher[test];]> Timing[selwyn[test];]> Timing[drbob[test];]> Timing[andrzej2[test];]>> {36.547*Second, Null}> {12.406000000000006*Second, Null}> {19.437000000000012*Second, Null}> {0.29700000000002547*Second, Null}> {3.7819999999999823*Second, Null}> {0.07800000000003138*Second, Null}> {0.06200000000001182*Second, Null}>> Neither Ôgray' nor Ôandrzej2' can handle more than two values in a > list,> and they give different answers in that case, while the others agree.> (They all agree on binary lists.)>> n = 1000;> test = Array[Round[3*Random[]] &, n];> andrzej1[test] == fisher[test] == selwyn[test] == hanlon[test] ==> drbob[test]> gray[test] == drbob[test]> andrzej2[test] == drbob[test]> gray[test] == andrzej2[test]>> True> False> False> False>> Here are timings on a list with 21 different values:>> n = 10000;> test = Array[Round[20Random[]] &, n];> Union[test]> Timing[hanlon[test];]> Timing[andrzej1[test];]> Timing[fisher[test];]> Timing[selwyn[test];]> Timing[drbob[test];]>> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, > 19,> 20}> {13.078000000000001*Second, Null}> {15.563000000000002*Second, Null}> {0.5779999999999959*Second, Null}> {2.9849999999999994*Second, Null}> {0.07800000000000296*Second, Null}>> and here are timings with 100 different values:>> n = 10000;> test = Array[Round[99Random[]] &, n];> Timing[hanlon[test];]> Timing[andrzej1[test];]> Timing[fisher[test];]> Timing[selwyn[test];]> Timing[drbob[test];]>> {12.969000000000001*Second, Null}> {15.765*Second, Null}> {2.2039999999999935*Second, Null}> {3.6400000000000006*Second, Null}> {0.09399999999999409*Second, Null}>> Ôfisher' seems badly affected by increasing the number of values.>> Bobby>> On Sun, 30 Mar 2003 08:00:57 +0900, Andrzej Kozlowski> If any one is interested in doing performance tests I suggest using >> my>> other function, which I also posted to the Mathgroup. The two >> functions>> were meant to demonstrate the difference between elegance (which I>> identify with shortness of code) and efficiency. Here is the >> efficient>> one (the algorithm works only for lists containing just two distinct>> symbols):>> f2[l_List] := Module[{mult =>> Length /@ Split[l], list1,>> list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, >> 1,>> Length[mult],>> 2}]]]; list2 =>> FoldList[Plus,>> 0, Table[mult[[i]], {i, 2, 2(>> Floor[(Length[mult] + 1)/2]) - 1, 2}]];>> values = Take[Flatten[Transpose[{list2,>> list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], {>> mult[[i]]}], {i, 1, Length[mult]}]]]> æææ I am again gratified for all the prompt, more-than-competent> solutions to my problem. I'm enclosing a .nb file with all replies> received so far so you can compare them. I did not do timing > because> the lists I have are relatively short and I don't need to call this> function very often.> æ> Steve Gray>> ----- Original Message -----> To: mathgroup@smc.vnet.net> To: stevebg@adelphia.net> Sent: Saturday, March 29, 2003 4:53 AM> æ æ Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> æ æ In a more general version, which I doæ not need now, s would> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an> unusual conjecture in geometry.> Andrzej Kozlowski>> Yokohama, Japan>> http://www.mimuw.edu.pl/~akoz/>> http://platon.c.u-tokyo.ac.jp/andrzej/>> -- majort@cox-internet.com> Bobby R. Treat>Reply-To: majort@cox-internet.com ==== Andrzej is quite right, Map is more natural here. He forgot to remove ÔRest', however.It should be:drbob3[s_List] := Block[{count, n = 0}, count[any_] := 0; Map[++n - (++count[#]) &, s]]ordrbob4[s_List] := Block[{count}, count[any_] := 0; Range@Length@s - Map[++count[#] &, s]]Much to my surprise, drbob and drbob4 have almost identical timings for 100 values in a list:n = 100000;test = Array[Round[99Random[]] &, n];Timing[drbob[test];]Timing[drbob2[test];]Timing[drbob3[ test];]Timing[drbob4[test];]{1.093999999999994*Second, Null}{1.718999999999994*Second, Null}{1.7659999999999911*Second, Null}{1.0930000000000177*Second, Null}But drbob4 beats drbob (slightly) for 21 values:n = 100000;test = Array[Round[20Random[]] &, n];Timing[drbob[test];]Timing[drbob2[test];]Timing[drbob3[ test];]Timing[drbob4[test];]{0.7970000000000255*Second, Null}{1.4530000000000314*Second, Null}{1.3900000000000432*Second, Null}{0.7810000000000059*Second, Null}and for binary lists:n = 100000;test = Array[Random[Integer] &, n];Timing[drbob[test];]Timing[drbob2[test];]Timing[drbob3[ test];]Timing[drbob4[test];]Timing[andrzej2[test];]{ 0.8440000000000225*Second, Null}{1.421999999999997*Second, Null}{1.421999999999997*Second, Null}{0.7649999999999864*Second, Null}{0.5310000000000059*Second, Null}BobbyOn Mon, 31 Mar 2003 13:53:50 +0900, Andrzej Kozlowski I agree that Bob's algorithm is the simplest and most natural of all > except that his use of FoldList seems to me to be intended to mystify > and confuse ;-)>> In fact>> drbob3[s_List] := Block[{count, n = 0},> count[any_] := 0;> Rest@Map[++n - (++count[#]) &, s]> ]>> does the same thing as drbob2 and is, at least on my machine, slightly > faster.>> As for the algorithm, it is essentially exactly what you would do if you > had to solve this problem by hand. You simply count how many times an > element in the n-th place has occurred and subtract it from n. The only > weakness of this algorithm is that when you get a repetition like > {b,a,a...} we know that the number of non a's before the second a is the > same as the number of non a's before the first a, so there is no need to > count but the algorithm wastes a tiny amount of time on recounting this > number again.>> My algorithm for two distinct values avoids this problem. It exploits the > fact that to solve the problem for just two distinct values you only need > to know:>> In[23]:=> Length/@Split[{a,b,b,a,a,a,b,a,b,a,a}]>> Out[23]=> {1,2,3,1,1,1,2}>> The numbers you see give you the number of repeats of the same value you > are going to see in the final list. You can also (here is the point where > the difference between two value case and the general case becomes > significant) work out what these values are going to be. The number you > are going to get in the k-th position, where k is even will be the sum of > the numbers in all the odd positions preceding k, and the value you get > in the k-t place when k is odd the sum of all the values in the even > positions preceding k.> Since my code depends on this fact it obviously can't be expected to work > with more than 2 values.>> Andrzej Kozlowski> Yokohama, Japan> http://www.mimuw.edu.pl/~akoz/> http://platon.c.u-tokyo.ac.jp/andrzej/> I actually think my code is the easiest to understand of them all, but I>> suppose every programmer thinks that!>> I had forgotten to time my other code, so here it is:>> drbob2[s_List] := Block[{count, n = 0},>> count[any_] := 0;>> Rest@FoldList[++n - (++count[#2]) &, Null, s]>> ]>> (Note that the second argument of FoldList, in both my solutions, is not>> used.)>> I timed Selwyn's new solution, and the four best (for more than 2 >> values)>> are now:>> n = 10000;>> test = Array[Round[99Random[]] &, n];>> Timing[fisher[test];]>> Timing[selwyn2[test];]>> Timing[drbob[test];]>> Timing[drbob2[test];]>> {2.171999999999997*Second, Null}>> {0.7180000000000035*Second, Null}>> {0.10999999999999943*Second, Null}>> {0.17199999999999704*Second, Null}>> Bobby>> On Sun, 30 Mar 2003 11:38:29 -0500, Selwyn Hollis >> > For what it's worth, I get a 4X speed-up by not using PrependTo, and a> minor improvement by using Block instead of Module within Scan:>> countdiffs[s_List] := Module[{members, totals, g, j},> members = Union[s];> totals = Count[s, #] & /@ members;> j = Length[s];> Scan[Block[{i = First@First@Position[members, #]},> g[j] = j - totals[[i]];> totals[[i]]--; j--] &, Reverse[s]];> Table[g[i], {i, Length[s]}]]>> But it's still much slower than drBob's brilliantly incomprehensible > code> :^)>> ---> Selwyn> Here are timings with a binary-valued list:>> n = 10000;>> test = Array[Random[Integer] &, n];>> Timing[gray[test];]>> Timing[hanlon[test];]>> Timing[andrzej1[test];]>> Timing[fisher[test];]>> Timing[selwyn[test];]>> Timing[drbob[test];]>> Timing[andrzej2[test];]>> {36.547*Second, Null}>> {12.406000000000006*Second, Null}>> {19.437000000000012*Second, Null}>> {0.29700000000002547*Second, Null}>> {3.7819999999999823*Second, Null}>> {0.07800000000003138*Second, Null}>> {0.06200000000001182*Second, Null}>> Neither Ôgray' nor Ôandrzej2' can handle more than two values in a >> list,>> and they give different answers in that case, while the others agree.>> (They all agree on binary lists.)>> n = 1000;>> test = Array[Round[3*Random[]] &, n];>> andrzej1[test] == fisher[test] == selwyn[test] == hanlon[test] ==>> drbob[test]>> gray[test] == drbob[test]>> andrzej2[test] == drbob[test]>> gray[test] == andrzej2[test]>> True>> False>> False>> False>> Here are timings on a list with 21 different values:>> n = 10000;>> test = Array[Round[20Random[]] &, n];>> Union[test]>> Timing[hanlon[test];]>> Timing[andrzej1[test];]>> Timing[fisher[test];]>> Timing[selwyn[test];]>> Timing[drbob[test];]>> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,>> 20}>> {13.078000000000001*Second, Null}>> {15.563000000000002*Second, Null}>> {0.5779999999999959*Second, Null}>> {2.9849999999999994*Second, Null}>> {0.07800000000000296*Second, Null}>> and here are timings with 100 different values:>> n = 10000;>> test = Array[Round[99Random[]] &, n];>> Timing[hanlon[test];]>> Timing[andrzej1[test];]>> Timing[fisher[test];]>> Timing[selwyn[test];]>> Timing[drbob[test];]>> {12.969000000000001*Second, Null}>> {15.765*Second, Null}>> {2.2039999999999935*Second, Null}>> {3.6400000000000006*Second, Null}>> {0.09399999999999409*Second, Null}>> Ôfisher' seems badly affected by increasing the number of values.>> Bobby>> On Sun, 30 Mar 2003 08:00:57 +0900, Andrzej Kozlowski> If any one is interested in doing performance tests I suggest using > my> other function, which I also posted to the Mathgroup. The two > functions> were meant to demonstrate the difference between elegance (which I> identify with shortness of code) and efficiency. Here is the > efficient> one (the algorithm works only for lists containing just two distinct> symbols):>> f2[l_List] := Module[{mult => Length /@ Split[l], list1,> list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, > 1,> Length[mult],> 2}]]]; list2 => FoldList[Plus,> 0, Table[mult[[i]], {i, 2, 2(> Floor[(Length[mult] + 1)/2]) - 1, 2}]];> values = Take[Flatten[Transpose[{list2,> list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], {> mult[[i]]}], {i, 1, Length[mult]}]]]>> æææ I am again gratified for all the prompt, more-than-competent>> solutions to my problem. I'm enclosing a .nb file with all replies>> received so far so you can compare them. I did not do timing because>> the lists I have are relatively short and I don't need to call this>> function very often.>> æ>> Steve Gray>> ----- Original Message ----->> To: mathgroup@smc.vnet.net>> To: stevebg@adelphia.net>> Sent: Saturday, March 29, 2003 4:53 AM>> æ æ Given a list consisting of only two distinct values, such as>> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length>> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position>> 1<=p<=Length[s], look at list s and set g[[p]] to the number of>> elements in s to the left of p which are not equal to s[[p]].>> æ æ In a more general version, which I doæ not need now, s would>> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an>> unusual conjecture in geometry.>> > Andrzej Kozlowski> Yokohama, Japan> http://www.mimuw.edu.pl/~akoz/> http://platon.c.u-tokyo.ac.jp/andrzej/>> -- majort@cox-internet.com>> Bobby R. Treat-- majort@cox-internet.comBobby R. Treat ==== f[s_?VectorQ] := Module[{n=0}, Fold[Append[#1,n-Count[Take[s, n++],#2]]&, {},s]];s={a,b,b,a,a,a,b,a,b,a,a};g={0,1,1,2,2,2,4,3,5,4,4};f[ s] == gTrues=Table[{a,b,c}[[Random[Integer, {1,3}]]], {15}]{a,b,a,c,b,b,a,c,a,b,a,b,a,a,c}f[s]{ 0,1,1,3,3,3,4,6,5,6,6,7,7,7,12}Bob Hanlon<< this particular calculation is used. The current application is anunusual conjecture in geometry. >>

==== Here is one (nice?) way of doing this that does not depend on how many different values s contains:f1[s_List] := MapIndexed[Length[DeleteCases[Take[s, First[#2]], #1]] &, s]and here is another one that works only (as it stands) with just two distinct values:f2[l_List] := Module[{mult = Length /@ Split[l], list1, list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, 1, Length[mult], 2}]]]; list2 = FoldList[Plus, 0, Table[mult[[i]], {i, 2, 2( Floor[(Length[mult] + 1)/2]) - 1, 2}]]; values = Take[Flatten[Transpose[{list2, list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], { mult[[i]]}], {i, 1, Length[mult]}]]]The second function is a lot more complex and may not satisfy your criteria of niceness but it is also a lot more efficient.Let's first make sure they both work correctly with your original s:In[3]:=s={a,b,b,a,a,a,b,a,b,a,a};In[4]:=f1[s]Out[4]={ 0,1,1,2,2,2,4,3,5,4,4}In[5]:=f2[s]Out[5]={ 0,1,1,2,2,2,4,3,5,4,4}Now let's try something bigger:In[6]:=s=Table[If[Random[Integer]==1,a,b],{10^3}];In[7 ]:=a=f1[s];//TimingOut[7]={1.37 Second,Null}In[8]:=b=f2[s];//TimingOut[8]={0.04 Second,Null}In[9]:=a==bOut[9]=TrueSo niceness doesn't always pays, it seems.Andrzej KozlowskiYokohama, Japanhttp://www.mimuw.edu.pl/~akoz/http:// platon.c.u-tokyo.ac.jp/andrzej/> Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an> unusual conjecture in geometry.>> ==== First rename a->1 b->2 (with s/.{a->1, b->2})and try this (a Ômore general version')In[]:=s = {1, 2, 2, 1, 1, 1, 2, 1, 2, 1, 1};In[]:=t = Table[0, {Max[s]}];sumt = 0;g = (sumt++ - t[[#]]++) & /@ s Mihajlo Vanevic mvane@EUnet.yu 2003-03-29*************************************************** ************ At 2003-03-29, 05:19:00 ************************************************************* *> Given a list consisting of only two distinct values, such as>s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length>g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position>1<=p<=Length[s], look at list s and set g[[p]] to the number of>elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would>not be restricted to only two distinct values.>>this particular calculation is used. The current application is an>unusual conjecture in geometry.**************************************************** ********** ==== Here's my attempt:Different[s_List] := Module[{types, i}, types = Union[s]; Thread[(i /@ types) == 0] /. Equal -> Set; (i[#]++; Tr[i /@ DeleteCases[types, #]]) & /@ s ]--Mark> Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would> not be restricted to only two distinct values.> this particular calculation is used. The current application is an> unusual conjecture in geometry.> ==== >Given a list consisting of only two distinct values, such as>s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length>g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position>1<=p<=Length[s], look at list s and set g[[p]] to the number of>elements in s to the left of p which are not equal to s[[p]]. Here is something that will do the trickMapThread[(Length[Take[s, #2]] - Length[Position[ Take[s, #2], #1]]) &, {s, Range[Length[s]]}] ==== Steve,Nice problem. The following seems to work pretty well (and on the more general problem): countdiffs[s_List] := Module[{members, totals, g}, members = Union[s]; totals = Count[s, #] & /@ members; g = {}; Scan[ Module[{i}, i = First@First@Position[members, #]; PrependTo[g, Plus @@ totals - totals[[i]]]; totals[[i]]--]&, Reverse[s] ]; g ] s = Table[Random[Integer, {1, 9}], {10}] {3, 4, 4, 9, 9, 4, 1, 6, 1, 3} countdiffs[s] {0, 1, 1, 3, 3, 3, 6, 7, 7, 8}Since this will probably become a speed contest :) ... s = Table[Random[Integer, {1, 9}], {5000}]; First@Timing[countdiffs[s];] 1.53 Second(4.1.5, Mac OS X, 1GHz DP)-----Selwyn Hollishttp://www.math.armstrong.edu/faculty/hollis> Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an> unusual conjecture in geometry.> ==== Oops, that timing was wrong. Should have beens = Table[Random[Integer, {1, 9}], {5000}];First@Timing[countdiffs[s];]2.36 Second-- SH> Steve,>> Nice problem. The following seems to work pretty well (and on the more > general problem):>> countdiffs[s_List] := Module[{members, totals, g},> members = Union[s];> totals = Count[s, #] & /@ members;> g = {};> Scan[ Module[{i}, i = First@First@Position[members, #];> PrependTo[g, Plus @@ totals - totals[[i]]];> totals[[i]]--]&,> Reverse[s] ];> g ]>> s = Table[Random[Integer, {1, 9}], {10}]>> {3, 4, 4, 9, 9, 4, 1, 6, 1, 3}>> countdiffs[s]>> {0, 1, 1, 3, 3, 3, 6, 7, 7, 8}>> Since this will probably become a speed contest :) ...>> s = Table[Random[Integer, {1, 9}], {5000}];> First@Timing[countdiffs[s];]>> 1.53 Second>> (4.1.5, Mac OS X, 1GHz DP)> -----> Selwyn Hollis> http://www.math.armstrong.edu/faculty/hollis> Given a list consisting of only two distinct values, such as>> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length>> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position>> 1<=p<=Length[s], look at list s and set g[[p]] to the number of>> elements in s to the left of p which are not equal to s[[p]].>> In a more general version, which I do not need now, s would>> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an>> unusual conjecture in geometry.>Reply-To: majort@cox-internet.com ==== leftCount[s_List] := Block[{count}, count[any_] := 0; Range@Length@s - Rest@FoldList[++count[#2] &, s, s]]leftCount[s]{0, 1, 1, 2, 2, 2, 4, 3, 5, 4, 4}orleftCount[s_List] := Block[{count, n = 0}, count[any_] := 0; Rest@FoldList[++n - (++count[#2]) &, s, s]]leftCount[s]{0, 1, 1, 2, 2, 2, 4, 3, 5, 4, 4}BobbyOn Sat, 29 Mar 2003 05:19:39 -0500 (EST), Steve Gray Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would> not be restricted to only two distinct values.>> this particular calculation is used. The current application is an> unusual conjecture in geometry.>-- majort@cox-internet.comBobby R. Treat ==== I'm new at this, but I'll take a shot:s = {a, b, b, a, a, a, b, a, b, a, a}; Table[j - Count[Take[s, j], s[[j]]], {j, Length[s]}]{0, 1, 1, 2, 2, 2, 4, 3, 5, 4, 4}-- Dana DeLouis Windows XP= = = = = = = = = = = = = = = = => Given a list consisting of only two distinct values, such as > s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length > g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position > 1<=p<=Length[s], look at list s and set g[[p]] to the number of > elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would not be > restricted to only two distinct values.> particular calculation is used. The current application is an unusual > conjecture in geometry.> Reply-To: kuska@informatik.uni-leipzig.de ==== Hi,UnequalLeft[lst_, symbs_] := Module[{l, i}, Map[ (i = 0; l[#1] = Map[Function[{x}, If[x =!= #1, i++, i]] , lst]) &, symbs]; MapIndexed[l[#][[First[#2]]] &, lst] ]and call it withUnequalLeft[s, {a, b}] Jens> Given a list consisting of only two distinct values, such as> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position> 1<=p<=Length[s], look at list s and set g[[p]] to the number of> elements in s to the left of p which are not equal to s[[p]].> In a more general version, which I do not need now, s would> not be restricted to only two distinct values.> this particular calculation is used. The current application is an> unusual conjecture in geometry. ==== Hallo dear community,I don't know whether this topic has been discussed ever since before.I like those socalled Oneliners to solve this or that problem. It shows up, how elegant and effective the Mathematica language can be.But to be honest: Isn't it a torture trying to understand the how does it work of a oneliner written by some else?Is it useful to use //TreeForm to visualize the inner structure of a oneliner (where is the inner beginning)The vast majority of oneliners presented here lack on comments. Despite of the wonderful constructs, is this good programming style?I'm looking forward to the next oneliner !Oliver Friedrich ==== Here's two plots, one linear and one not so linear ;)Plot[ {3x+5, x^2}, {x, -10, 10} ]And I want to know the intersection points of the two expressions.Is there a simple way to do this, and is it extensible to three or fourexpressions?Reply-To: majort@cox-internet.com ==== Solve[Equal @@ {3x + 5, x^2}, x]{{x -> (1/2)*(3 - Sqrt[29])}, {x -> (1/2)*(3 + Sqrt[29])}}BobbyOn Sun, 30 Mar 2003 04:07:47 -0500 (EST), AngleWyrm > Here's two plots, one linear and one not so linear ;)>> Plot[ {3x+5, x^2}, {x, -10, 10} ]>> And I want to know the intersection points of the two expressions.>> Is there a simple way to do this, and is it extensible to three or four> expressions?>>-- majort@cox-internet.comBobby R. TreatReply-To: majort@cox-internet.com ==== << Graphics`Graphics`f = 3x + 5;g = x^2;Block[{solns = Solve[f == g, x]}, DisplayTogether[Plot[{f, g}, {x, -10, 10}], Graphics[{ AbsolutePointSize[6], {Point[{x, f}], Text[x, {x, f}, {0, -1}]} /. solns}], ImageSize -> 400]; ]BobbyOn Sun, 30 Mar 2003 04:07:47 -0500 (EST), AngleWyrm > Here's two plots, one linear and one not so linear ;)>> Plot[ {3x+5, x^2}, {x, -10, 10} ]>> And I want to know the intersection points of the two expressions.>> Is there a simple way to do this, and is it extensible to three or four> expressions?>>-- majort@cox-internet.comBobby R. TreatReply-To: kuska@informatik.uni-leipzig.de ==== Hi,funs = {3x + 5, x^2};Plot[Evaluate[funs], {x, -10, 10}, Epilog -> {PointSize[ 0.05], (Point[{#, funs[[1]] /. x -> #}] & /@ (x /. Solve[Equal @@ funs, x]))}] Jens> Here's two plots, one linear and one not so linear ;)> Plot[ {3x+5, x^2}, {x, -10, 10} ]> And I want to know the intersection points of the two expressions.> Is there a simple way to do this, and is it extensible to three or four> expressions?