14575 http://www.wolfram.com/products/applications/excel_link/ Jens > > > is there any way of linking Mathematica with Excel? > > Lu.92s ==== I am getting the same problem (though Mathematica 4.1). Has anyone any ideas? Aron. > >I am facing the problem in starting the link to math kernel from within >Excel. > >Specifically, when I get the message link failed to open when I click >Launch button in the 'Start Mathematica Link' dialog box. I have tried using >Multilink too so that I am able to access the kernel from Mathematica and >Excel simultaneously but I still get the same message. > >I am currently using Mathematica 4.0 and Excel 2002 (Excel XP). The programs >Mathematica and Excel otherwise appear to work fine. I am using Windows XP >home edition on Dell 8100 laptop. I have used the Mathematica Link for MS >Excel for Excel 2000 in my installation as there were no specific files for >Excel 2002. Given that I was able to successfully add the menus within excel >I think the addin should work fine but it does not? > >All help would be sincerely appreciated. > >Sincerely, > >Tahir Sheikh. ==== Download the 2002 file from this page. I use it for Excel 2002 Service Pack 2. http://support.wolfram.com/applicationpacks/excel_link/excelxp.html > > I am getting the same problem (though Mathematica 4.1). > Has anyone any ideas? > > Aron. > > > >I am facing the problem in starting the link to math kernel from within >Excel. > >Specifically, when I get the message link failed to open when I click >Launch button in the 'Start Mathematica Link' dialog box. I have tried > using >Multilink too so that I am able to access the kernel from Mathematica > and >Excel simultaneously but I still get the same message. > >I am currently using Mathematica 4.0 and Excel 2002 (Excel XP). The > programs >Mathematica and Excel otherwise appear to work fine. I am using Windows > XP >home edition on Dell 8100 laptop. I have used the Mathematica Link for > MS >Excel for Excel 2000 in my installation as there were no specific files > for >Excel 2002. Given that I was able to successfully add the menus within > excel >I think the addin should work fine but it does not? > >All help would be sincerely appreciated. > >Sincerely, > >Tahir Sheikh. > > > ==== I did not request any accuracy for f. I set the accuracy of the numerical components of the expression f. You cannot request the accuracy of the result of your computation in Mathematica, you can only set the accuracy of the input and later check what accuracy of the output results form it. In my last message on this topic I tried to explain this in the plainest and simplest way I could think of. There is nothing more left for me to say. I feel like Sisyphus but unlike him I can at least give up! Andrzej Kozlowski >> >> [...] >> >> I would say this is correct and show that SetPrecision is very useful >> indeed. It tells you (what of course you ought to already know in this >> case anyway) that machine precision will not give you a realiable >> answer in this case. If you know your numbers with a great deal of >> accuracy you can get an accurate answer: >> >> In[24]:= >> f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - >> 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; >> a=SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; >> >> >> In[26]:= >> {f, Precision[f]} >> >> Out[26]= >> {-0.82739605994682136814116509547981629199903311578438481991 >> 781484167246798617832`61.2597, 61} >> > > Congratulations! You just requested accuracy of 100 for f and got 61 ( > to convince yourself add Accuracy[f] to In[26]). If In[24] one > replaces SetAccuracy by SetPrecision the result is similar. > > PK > >> Again you can be pretty sure that you got an accurate answer, provided >> of course your original setting of precision was valid. >> >> Honestly, to say that SetPrecision and SetAccuaracy are useless is one >> of the silliest thing I have read on this list in years. >> >> > >> Andrzej Kozlowski >> Yokohama, Japan >> http://www.mimuw.edu.pl/~akoz/ >> http://platon.c.u-tokyo.ac.jp/andrzej/ > > > Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ Reply-To: ==== Here's a more intuitive method, perhaps: a + b/c + d*(Sqrt[e]/c) == 0 f = %[[1, 3]] %% /. f -> g First@Solve[%, g] f^2 == (g^2 /. %) However, it occurs to me you might want a more general method to collect a radical on one side and then square both sides. If so, here's a clumsy first attempt: expr = a + b/c + d*(Sqrt[e]/c) == 0 f = First@Cases[expr, Power[a_, Rational[b_, c_]], Infinity] power = First@Cases[f, Rational[b_, c_] -> Rational[c, b], Infinity] coefficient = First@Cases[expr, Times[a_, f] -> a, Infinity] Solve[expr /. coefficient f -> g, g][[1, 1]] g^2 == (g^2 /. %) % /. g -> coefficient f DrBob -----Original Message----- DrBob -----Original Message----- want the equation to be written out with terms grouped by powers of x, but I think I can do that part :) I'll be very grateful to anyone who can give me some pointers. Or, at least point me to some tutorial in the Mathematica documentation. I've been looking over the documentation and I found Appendix A.5 in The Mathematica Book, but that doesn't help me. I _need_ some examples. I did find a couple of well-written posts in this newsgroup, but not quite close enough to what I want. Troy. =-=-=-=-=-=-=-=-=-= FYI, here's the expression I'm working with. denom = Sqrt[(B^2 - r^2)^2 + 4*(r^2)*(b^2)] cnu = (2*b^2 - B^2 + r^2)/denom snu = -2*b*Sqrt[B^2 - b^2]/denom sif = 2*r*b/denom cif = (r^2 - B^2)/denom pdr = -Cos[ds]*Sin[q]*(snu*cif + cnu*sif) - Sin[ds]*(cnu*cif - snu*sif) 0 == -(B^2 - b^2)*V^2/(r^2) + (((B*V)^2)/( r^2) - 2*w*b*V*Cos[q]*Cos[ds] + (w* r)^2 - (w*r*pdr)^2)*(Cos[qr])^2 Although I said it's a polynomial in x, it's really a polynomial in b that I'm after. ==== > > On Friday, October 4, 2002, at 06:01 PM, DrBob > >[...] > > I would say this is correct and show that > SetPrecision is very useful > indeed. It tells you (what of course you ought > to already know in this > case anyway) that machine precision will not > give you a realiable > answer in this case. If you know your numbers > with a great deal of > accuracy you can get an accurate answer: > > In[24]:= > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - > b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > a=SetPrecision[77617.,100]; b = > SetPrecision[33096.,100]; > > > In[26]:= > {f, Precision[f]} > > Out[26]= > > {-0.82739605994682136814116509547981629199903311578438481991 > 781484167246798617832`61.2597, 61} > > > Congratulations! You just requested accuracy of > 100 for f and got 61 ( > to convince yourself add Accuracy[f] to In[26]). > If In[24] one > replaces SetAccuracy by SetPrecision the result is > similar. > > PK > [...] > > One has (initially) an accuracy of 100 for an > expression that contains > variables. > > In[25]:= Clear[a,b,f] > > In[26]:= f = SetAccuracy[333.75*b^6 + > a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > > In[27]:= Accuracy[f] > Out[27]= 100. > > Now we assign values to some indeterminants in f. > > In[28]:= a = SetPrecision[77617.,100]; b = > SetPrecision[33096.,100]; > > In[29]:= {f, Precision[f], Accuracy[f]} > Out[29]= > {-0.8273960599468213681411650954798162919990331157843848199178148, > > 61.2599, 61.3422} > > The precision and accuracy has dropped. This is all > according to > standard numerical analysis regarding cancellation > error. You'll find it > in any textbook on the topic. > Assume that I want accuracy and precision of 100 for f. You advice me to make experiments to find out, what should be the initial precision and accuracy of a and b to reach the requested accuracy and precision for f. Notice, that you cannot just repeat I[26], we saw already what happens. I have to re-type I[24], I[25], I[26], I[27], I[28], and I[29] as many times as needed to get f with accuracy and precision 100. Dan, you simply advocate to do MANUAL WORK that should be done by machine. Let's suppose that in the above example I just want 60 digits not 61. Precisely, I want 60 digits and nothing or zeros afterwards. Let's see if I could use SetAccuracy. In[30]:= SetAccuracy[%, 60] Out[30]= -0.82739605994682136814116509547981629199903311578438481991781 In[31]:= % // FullForm Out[30]//FullForm= -0.827396059946821368141165095479816291999033115784384819917814841672467988` 59.9177 Oops, it did not work (as expected). Let's highlight with mouse the expression in Out[30] and copy to a new cell. Oops, we got -0.827396059946821368141165095479816291999033115784384819917814841672467988` 59.9177 again. Let's change Out[30] to a text cell and then copy. In[31]:= -0.82739605994682136814116509547981629199903311578438481991781 Out[31]= -0.82739605994682136814116509547981629199903311578438481991781 Success? Not so fast. In[32]:= % // FullForm Out[32]//FullForm= -0.8273960599468213681411650954798162919990331157843848199178099999999999986 35 08`59.2041 Dan, is there any simple way to get what I want? As I repeated already number of times, at this stage of the development of computer technology, software should do it for me (!). We both know that this is doable. Some of the textbooks that you just advised me to read describe it. As a developer of Mathematica, tell us why do you consider this to be a bad idea? Peter Kosta > As for what happens when you artificially raise > precision (or accuracy) > of machine numbers far beyond that guaranteed by > their internal > representation, that falls into to category of > garbage in, garbage out. > It is, howoever, valid to use SetPrecision to raise > precision in > (typically iterative) algorithms where significance > arithmetic might be > unduly pessimistic due to incorrect assumptions > about uncorollatedness > of numerical error. Examples of such usage have > appeared in this news > group. > > > Daniel Lichtblau > Wolfram Research __________________________________________________ Do you Yahoo!? http://faith.yahoo.com ==== > Are there any known issues with simpy treating the JLink.jar as a Java > extension as follows? > cp JLink.jar $JAVA_HOME/jre/lib/ext? > According to my understanding of the discussion in the Java Tutorial on > extensions, that should work: It does; starting with M4.2, J/Link 2.0 gets preinstalled and comes with a 1.4 murphee ==== Are there any known issues with simpy treating the JLink.jar as a Java extension as follows? cp JLink.jar $JAVA_HOME/jre/lib/ext? According to my understanding of the discussion in the Java Tutorial on extensions, that should work: http://java.sun.com/docs/books/tutorial/ext/basics/install.html Commants? STH . ==== >Are there any known issues with simpy treating the JLink.jar as a Java >extension as follows? >cp JLink.jar $JAVA_HOME/jre/lib/ext? > >According to my understanding of the discussion in the Java Tutorial on >extensions, that should work: >http://java.sun.com/docs/books/tutorial/ext/basics/install.html > >Commants? You should not do this. Code from the jre/lib/ext directory is trusted, so this poses a security risk from malicious applets. Leave JLink.jar where it lives in the JLink directory. If you want it to be available to all Java programs on your system, add its location to your CLASSPATH environment variable (this is not a security risk, as remote applets cannot load classes from CLASSPATH). Todd Gayley Wolfram Research ==== The key is in using the command Factor with the option Extension: In[1]:= Factor[x^4 + x^3 + x^2 + x + 1, Extension -> {GoldenRatio}] Out[1]= -((-1 - x + GoldenRatio*x - x^2)*(1 + GoldenRatio*x + x^2)) For manual verification you should keep in mind that: 1/GoldenRatio = GoldenRatio - 1 Germ.87n Buitrago ----- Original Message ----- > (x^2 + GoldenRatio x + 1) ( x^2 - 1/GoldenRatio x + 1) > > What instructions do I need to execute to achieve this output? > > -Steve Earth > Harker School > http://www.harker.org/ > ==== Actually, including 1/GoldenRatio in the extension leads to an unnecessarily complicated formula. In this case there is no real need to so, since by definition In[30]:= Unevaluated[1/GoldenRatio==GoldenRatio-1]//FullSimplify Out[30]= True If one really insists on having the answer in the form proposed in Steve's original posting one can simply do: (Collect[#1, x] & ) /@ Factor[x^4 + x^3 + x^2 + x + 1, Extension -> {GoldenRatio}] /. -1 + GoldenRatio -> 1/GoldenRatio (-(-1 + x/GoldenRatio - x^2))*(1 + GoldenRatio*x + x^2) > > In[]:=Factor[x^4 + x^3 + x^2 + x + 1, Extension -> {GoldenRatio, > 1/GoldenRatio}] > Out[]=-((-3 - 2*x + Sqrt[5]*x + GoldenRatio*x - 3*x^2)* > (3 + x + Sqrt[5]*x + GoldenRatio*x + 3*x^2))/9 > > Jens > >> >> Greetings MathGroup, >> >> My name is Steve Earth, and I am a new subscriber to this list and >> also a >> new user of Mathematica; so please forgive this rather simple >> question... >> >> I would like to enter the quartic x^4 + x^3 + x^2 + x + 1 into >> Mathematica >> and have it be able to tell me that it factors into >> >> (x^2 + GoldenRatio x + 1) ( x^2 - 1/GoldenRatio x + 1) >> >> What instructions do I need to execute to achieve this output? >> >> -Steve Earth >> Harker School >> http://www.harker.org/ > > > Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ ==== I want to apply a function to every k-th element of a long list and add the result to the k+1 element. [Actually k = 3 and I just want to multiply myList[[k]] by a constant (independent of k) and add the result to myList[[k+1]] for every value of k that's divisible by 3.] Is there a way to do this -- or in general to get at every k-th element of a list -- that's faster and more elegant than writing a brute force Do[] loop or using Mod[] operators, and that will take advantage of native List operators, but still not be too recondite? I've been thinking about multiplying a copy of myList by a mask list {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. Better ways??? ==== Take[list, am, n, sa] gives elements m through n in steps of s. > I want to apply a function to every k-th element of a long list and > add the result to the k+1 element. > > [Actually k = 3 and I just want to multiply myList[[k]] by a > constant (independent of k) and add the result to myList[[k+1]] for > every value of k that's divisible by 3.] > > Is there a way to do this -- or in general to get at every k-th > element of a list -- that's faster and more elegant than writing a brute > force Do[] loop or using Mod[] operators, and that will take > advantage of native List operators, but still not be too recondite? > > I've been thinking about multiplying a copy of myList by a mask list > {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. > Better ways??? ==== lst= Range[14] {1,2,3,4,5,6,7,8,9,10,11,12,13,14} A list of positions in lst ( for your purpose Range[1, Length[lst], 3] will do) ps= {3,5,10}; The following applies h to each ps element in lst and adds the result to the following element (lst[[ps+1]]=h/@lst[[ps]]+lst[[ps+1]];lst) {1,2,3,4+h[3],5,6+h[5],7,8,9,10,11+h[10],12,13,14} -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > I want to apply a function to every k-th element of a long list and > add the result to the k+1 element. > > [Actually k = 3 and I just want to multiply myList[[k]] by a > constant (independent of k) and add the result to myList[[k+1]] for > every value of k that's divisible by 3.] > > Is there a way to do this -- or in general to get at every k-th > element of a list -- that's faster and more elegant than writing a brute > force Do[] loop or using Mod[] operators, and that will take > advantage of native List operators, but still not be too recondite? > > I've been thinking about multiplying a copy of myList by a mask list > {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. > Better ways??? > ==== Consider the following approach, whish uses the MapAt command, that is Map with 'mapping-position' control. dummyFun={#,trueFun@#}& list={a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p} spec=Partition[Range[3,Length[list],3],1] MapAt[dummyFun,list,spec] %//Flatten Hope that is what you want, Borut | I want to apply a function to every k-th element of a long list and | add the result to the k+1 element. | | [Actually k = 3 and I just want to multiply myList[[k]] by a | constant (independent of k) and add the result to myList[[k+1]] for | every value of k that's divisible by 3.] | | Is there a way to do this -- or in general to get at every k-th | element of a list -- that's faster and more elegant than writing a brute | force Do[] loop or using Mod[] operators, and that will take | advantage of native List operators, but still not be too recondite? | | I've been thinking about multiplying a copy of myList by a mask list | {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. | Better ways??? | Reply-To: kuska@informatik.uni-leipzig.de ==== something like: With[{k=3}, Flatten[ {#[[2]] + c*#[[1]], #[[3]]} & /@ Partition[lst, k, k, {1, 1}], 1] ] ?? Jens > > I want to apply a function to every k-th element of a long list and > add the result to the k+1 element. > > [Actually k = 3 and I just want to multiply myList[[k]] by a > constant (independent of k) and add the result to myList[[k+1]] for > every value of k that's divisible by 3.] > > Is there a way to do this -- or in general to get at every k-th > element of a list -- that's faster and more elegant than writing a brute > force Do[] loop or using Mod[] operators, and that will take > advantage of native List operators, but still not be too recondite? > > I've been thinking about multiplying a copy of myList by a mask list > {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. > Better ways??? Reply-To: ==== Daniel, >>The precision/accuracy tracking mechanism will generally let you know, in some fashion, that you have no trustworthy digits. But it is up to the user to check that sort of thing. In this case Mathematica did NOT let us know, in any fashion, that we had no trustworthy digits. Precision and Accuracy outputs were completely misleading. (16 and -5 respectively.) Even Andrzej Kozlowski, who's adept in Mathematica, thought that would be meaningful, and never came up with a better way to check (other than using infinite precision for numbers that probably aren't known that exactly). Peter Kosta demonstrated that he could get a completely erroneous answer with Infinite precision. I blame the problem primarily, and I don't think there's any way to make the answer meaningful. That's not Mathematica's fault at all, and users need to be aware of that old maxim: garbage in, garbage out. comes up with a 22-digit result, it doesn't take much sophistication to realize the answer can't have 16-digit precision. Here's an even more extreme result: f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 50]; a = 77617.; b = 33096.; f Precision[f] -1.180591620717411303424`71.0721*^21 71 71.0721 digits of precision? I don't think so!! We can do the following instead: x = Interval[333.75]; y = Interval[5.5]; a = Interval[77617.]; b = Interval[33096.]; x*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + y*b^8 + a/(2*b) Interval[{-4.486248158726164*^22, 4.2501298345826815*^22}] and that looks like the right answer, finally!! I like that method. However, that doesn't change the fact that Accuracy, Precision, and SetAccuracy appear to be completely useless. I haven't seen an example in which they did what anyone (but you) thought they should do. Bobby -----Original Message----- > you're not aware there's a problem, it lets you go on your merry way, > working with noise. > > Bobby Mathematica is not a mind reader. But the evaluation sequence, while complicated, is reasonably well documented. If you perform machine arithmetic, or for that matter significance arithmetic, and there is massive cancellation error, no use of SetAccuracy after the fact will fix it. The precision/accuracy tracking mechanism will generally let you know, in some fashion, that you have no trustworthy digits. But it is up to the user to check that sort of thing. It is not obvious to me what sort of error the software might notice to report. If you have a concise example of input, and expected output, I can look further. I've not seen anything in this thread that struck me as a failure of the software to warn the user, but maybe I missed something. Daniel ==== GentleBeings I have a straightforward implementation of successive approximations but I cannot seem to froce the code to find the correct solution when I have trig or exponentials involved. Can the assembled wisdom point to straghtforward fixes I know FindRoot works the object is to teach programming and successive approx, tho. kenf Below is the code Clear[f, g, gi, lim, r, rr, fr, gir, a, b, c, d, conv]; Plot[{x * ((x + 3)), 10*Sin[x]}, {x, 0.01, 2.4}, PlotStyle -> {{RGBColor[1, 0, 0], Thickness[ .006]}, {RGBColor[0, 0, 1], Thickness[ .006]}} ]; rr = FindRoot[x * ((x + 3)) == 10*Sin[x], {x, 2, 0.01, 2.4}]; f[a_] := a * ((a + 3)) /; a > 0; g[b_] := 10. * Sin[b] /; b > 0; gi[c_] := ArcSin[0.1*c] /; c > 0; Print[Actual root is , rr]; lim = 10; r = 2.0; conv = 10^-4; For[i = 1, i < lim, i++, { fr = f[r]; gir = gi[fr]; d = Abs[N[gir] - r]; i If[d < conv, Break[]]; r = gir; Print[The value of x = , r, found after , i, iterations,, with a tolerence , d, n] } ] Print[The value of x = , r, found after , i, iterations,, with a tolerence , d, n] Every man, woman and responsible child has an unalienable individual, civil, Constitutional and human right to obtain, own, and carry, openly or concealed, any weapon -- rifle, shotgun, handgun, machine gun, anything -- any time, any place, without asking anyone's permission. L. Neil Smith ==== > I want to apply a function to every k-th element of a long list and > add the result to the k+1 element. > > [Actually k = 3 and I just want to multiply myList[[k]] by a > constant (independent of k) and add the result to myList[[k+1]] for > every value of k that's divisible by 3.] > > Is there a way to do this -- or in general to get at every k-th > element of a list -- that's faster and more elegant than writing a > brute > force Do[] loop or using Mod[] operators, and that will take > advantage of native List operators, but still not be too recondite? > > I've been thinking about multiplying a copy of myList by a mask > list > {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. > Better ways??? > > Here is a generalization of what you've asked: f[l_List,c_,k_Integer,p_Integer]:=Flatten[Block[{r=#[[k]] c},Join[Take[#,k-1],{r,#[[k+1]]+ r},Drop[#,k+1]]]&/@Partition[l,p]]/;(Mod[Length[l],p]==0&&k (Expand[#1] == Expand[#2] & )] {(1 + (1/2)*(1 - Sqrt[5])*x + x^2)* (1 + (1/2)*(1 + Sqrt[5])*x + x^2)} Andrzej Kozlowski Toyama International University JAPAN http://sigma.tuins.ac.jp/~andrzej/ > Steve > The notebook given after NOTEBOOK below contains functions for > factoring and > partial fractioning. > Here is an application to your problem: the first stage avoids our > needing > to know anything about the answer. > > fc=FactorR[x^4+x^3+x^2+x+1,x] > > (1 - (1/2)*(-1 - Sqrt[5])*x + x^2)* > (1 - (1/2)*(-1 + Sqrt[5])*x + x^2) > > Now we need to get rid of Sqrt[5] in terms of GoldenRatio. > This is rather messy: > > Simplify/@(fc/. Sqrt[5][Rule]2 GoldenRatio-1) > > (1 + x - GoldenRatio*x + x^2)*(1 + GoldenRatio*x + x^2) > > Simplify/@(%/.-GoldenRatio[Rule] 1/GoldenRatio -1) > > (1 + x/GoldenRatio + x^2)*(1 + GoldenRatio*x + x^2) > > > Another example > > PartialFractionsR[(1 + x)x/(1 - 3*x + x^2), x] > > 1 - (2*(-1 + 4*x))/((3 + Sqrt[5] - 2*x)*(-3 + 2*x)) + > (2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt[5] + 2*x)) > > Simplify[%] > > (x*(1 + x))/(1 - 3*x + x^2) > > NOTEBOOK: to make a notebook from the following, copy from the next > line to > the line preceding XXX and paste into a new Mathematica notebook. > > Notebook[{ > > Cell[CellGroupData[{ > Cell[Factors and PartialFractions, Subtitle], > > Cell[Allan Hayes, 16 August 2001, Text], > > Cell[< > Here are some functions for factoring and expressing in partial > fractions over the reals and over the complex numbers. > >, Text], > > Cell[BoxData[ > (Quit)], Input], > > Cell[BoxData[{ > (Off[General::spell1, General::spell]), n, > ((FactorC::usage = polynomial in x with complex coefficients, gives its factorization > over the complex numbers.n > The output may include Root objects which may be evaluated with > ToRadicals or N.>;)n), n, > ((FactorR::usage = polynomial in x with real coefficients, gives its factorization over > the reals.n > The output may include Root objects which may be evaluated with > ToRadicals or N.>;)n), n, > ((PartialFractionsC::usage = where ratl is a rational in x with complex coefficients, gives its > factorization over the complex numbers.n > The output may include Root objects which may be evaluated with > ToRadicals or N.>;)n), n, > ((PartialFractionsR::usage = where ratl is a rational in x with real coefficients, gives its > factorization over the real numbers.n > The output may include Root objects which may be evaluated with > ToRadicals or N.>;)), n, > (On[General::spell1, General::spell])}], Input, > InitializationCell->True], > > Cell[TextData[{ > FactorC[p_, x_] := , > StyleBox[(*over complex numbers*), > FontFamily->Arial, > FontWeight->Plain], > nTimes @@ Cases[Roots[p == 0, x, n Cubics -> False], u_ == > v_ -> x - v]n nFactorR[p_, x_] := , > StyleBox[(*over reals, coefficients must be real*), > FontFamily->Arial, > FontWeight->Plain], > n (Times @@ Join[Cases[#1, u_ == v_ /; Im[v] == 0 :> n x > - v], Cases[#1, u_ == v_ /; Im[v] > 0 :> n x^2 - x*2*Re[v] + > Abs[v]^2]] & )[n Roots[p == 0, x, Cubics -> False]] > }], Input, > InitializationCell->True], > > Cell[TextData[{ > PartialFractionsC[p_, x_] := , > StyleBox[(*over complex numbers*), > FontFamily->Arial, > FontWeight->Plain], > n(#+Apart[#2/FactorC[#3,x]])&@@Flatten[{PolynomialReduce[#,#2], > #2}]&[Numerator[#],Denominator[#]]&[Together[p]]n n > PartialFractionsR[p_, x_] := , > StyleBox[(*over reals, coefficients must be real*), > FontFamily->Arial, > FontWeight->Plain], > n(#+Apart[#2/FactorR[#3,x]])&@@Flatten[{PolynomialReduce[#,#2], > #2}]&[Numerator[#],Denominator[#]]&[Together[p]] > }], Input, > InitializationCell->True], > > Cell[CellGroupData[{ > > Cell[PROGRAMMING NOTES, Subsubsection], > > Cell[TextData[{ > The option , > StyleBox[Cubics->False, > FontFamily->Courier], > is used to keep the roots of cubics in , > StyleBox[Root[....], > FontFamily->Courier], > form. This is better for computation.n, > StyleBox[Re[v], > FontFamily->Courier], > and , > StyleBox[Abs[v]^2, > FontFamily->Courier], > are used rather than , > StyleBox[v+Conjugate[v] , > FontFamily->Courier], > and , > StyleBox[v*Conjugate[v], > FontFamily->Courier], > to prevent , > StyleBox[Apart, > FontFamily->Courier], > from factorising , > StyleBox[x^2 - x*2*Re[v] + Abs[v]^2], > FontFamily->Courier], > back to complex form. > }], Text] > }, Closed]], > > Cell[CellGroupData[{ > > Cell[EXAMPLES, Subsubsection], > > Cell[pol = Expand[(x - 1)*(x + 1)^2*(x^2 + x + 1)^2*(x^2 + 4)]; , > Input], > > Cell[CellGroupData[{ > > Cell[f1 = FactorC[pol, x], Input], > > Cell[BoxData[ > ((((-1) + x)) (((-2) [ImaginaryI] + > x)) ((2 [ImaginaryI] + > x)) ((1 + x))^2 (((((-1)))^(1/3) + x))^2 > (((-(((-1)))^(2/3)) + x))^2)], Output] > }, Open ]], > > Cell[CellGroupData[{ > > Cell[f2 = FactorR[pol, x], Input], > > Cell[BoxData[ > ((((-1) + x)) ((1 + x))^2 ((4 + > x^2)) ((1 + x + x^2))^2)], Output] > }, Open ]], > > Cell[CellGroupData[{ > > Cell[f3 = FactorR[x^3 + x + 1, x], Input], > > Cell[BoxData[ > (((x - Root[1 + #1 + #1^3 &, 1])) ((x^2 - > 2 x Root[(-1) + 2 #1 + 8 #1^3 &, 1] + > Root[(-1) - #1^4 + #1^6 &, 2]^2)))], Output] > }, Open ]], > > Cell[< > Root objects appear because of the option Cubics->False in Roots. > We can sometimes get radical forms, but notice the complication. > >, Text], > > Cell[CellGroupData[{ > > Cell[ToRadicals[f3], Input], > > Cell[BoxData[ > (((((2/(3 (((-9) + @93)))))^(1/3) - ((1/2 > (((-9) + @93))))^(1/3)/3^(2/3) + x)) ((1/3 + > 1/3 ((29/2 - (3 @93)/2))^(1/3) + > 1/3 ((1/2 ((29 + 3 @93))))^(1/3) - > 2 ((((1/2 ((9 + @93))))^(1/3)/(2 > 3^(2/3)) - > 1/(2^(2/3) ((3 ((9 + > @93))))^(1/3)))) x + x^2)))], Output] > }, Open ]], > > Cell[Inexact forms can be found, from f3 :, Text], > > Cell[CellGroupData[{ > > Cell[N[f3], Input], > > Cell[BoxData[ > (((((0.6823278038280193`)([InvisibleSpace])) + > x)) ((((1.4655712318767682`)([InvisibleSpace])) - > 0.6823278038280193` x + x^2)))], Output] > }, Open ]], > > Cell[or directly, Text], > > Cell[CellGroupData[{ > > Cell[f3 = FactorR[x^3 + x + 1//N, x], Input], > > Cell[BoxData[ > (((((0.6823278038280193`)([InvisibleSpace])) + > x)) ((((1.4655712318767682`)([InvisibleSpace])) - > 0.6823278038280193` x + x^2)))], Output] > }, Open ]], > > Cell[Partial fractions, Text], > > Cell[CellGroupData[{ > > Cell[pf1 = PartialFractionsR[(2 + x)/pol, x], Input], > > Cell[BoxData[ > (1/(60 (((-1) + x))) - 1/(10 ((1 + x))^2) - > 39/(100 ((1 + x))) + ((-54) - 31 x)/(4225 ((4 + > x^2))) + ((-1) + 3 x)/(13 ((1 + x + x^2))^2) + (44 + > 193 x)/(507 ((1 + x + x^2))))], Output] > }, Open ]], > > Cell[CellGroupData[{ > > Cell[pf2 = PartialFractionsR[(1 + x)x/(1 - 3*x + x^2), x], > Input], > > Cell[< > 1 - (2*(-1 + 4*x))/((3 + Sqrt[5] - 2*x)*(-3 + 2*x)) + > (2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt[5] + 2*x)) > >, Output] > }, Open ]], > > Cell[CellGroupData[{ > > Cell[BoxData[ > (Simplify[%])], Input], > > Cell[(x*(1 + x))/(1 - 3*x + x^2), Output] > }, Open ]], > > Cell[Partial fractions will often involve Root objects , Text], > > Cell[CellGroupData[{ > > Cell[pf3 = PartialFractionsR[(1 + x)/(x^3 - x + 1), x], Input], > > Cell[BoxData[ > (((1 + > Root[1 - #1 + #1^3 &, > 1]))/((((x - > Root[1 - #1 + #1^3 &, > 1])) ((Root[1 - #1 + #1^3 &, 1]^2 - > 2 Root[1 - #1 + #1^3 &, > 1] Root[(-1) - 2 #1 + 8 #1^3 &, 1] + > Root[(-1) + #1^4 + #1^6 &, 2]^2)))) + ((x + > Root[1 - #1 + #1^3 &, 1] + > x Root[1 - #1 + #1^3 &, 1] - > 2 Root[(-1) - 2 #1 + 8 #1^3 &, 1] - > Root[(-1) + #1^4 + #1^6 &, 2]^2))/(((((-x^2) + > 2 x Root[(-1) - 2 #1 + 8 #1^3 &, 1] - > Root[(-1) + #1^4 + #1^6 &, 2]^2)) ((Root[1 - > #1 + #1^3 &, 1]^2 - > 2 Root[1 - #1 + #1^3 &, > 1] Root[(-1) - 2 #1 + 8 #1^3 &, 1] + > Root[(-1) + #1^4 + #1^6 &, 2]^2)))))], > Output] > }, Open ]], > > Cell[This can in fact be put in radical form:, Text], > > Cell[CellGroupData[{ > > Cell[ToRadicals[pf3], Input], > > Cell[BoxData[ > (((1 - ((2/(3 ((9 - @69)))))^(1/3) - ((1/2 ((9 > - @69))))^(1/3)/3^(2/3)))/(((((-(1/3)) + > 1/3 ((25/2 - (3 @69)/2))^(1/3) + > 1/3 ((1/2 ((25 + 3 @69))))^(1/3) + > (((-((2/(3 ((9 - @69)))))^(1/3)) - ((1/2 ((9 - > @69))))^(1/3)/3^(2/3)))^2 - > 2 (((-((2/(3 ((9 - @69)))))^(1/3)) - > ((1/2 ((9 - @69))))^(1/3)/3^(2/3))) ((1/24 ((864 > - 96 @69))^(1/3) + ((1/2 ((9 + @69))))^(1/3)/(2 > 3^(2/3)))))) ((((2/(3 ((9 - @69)))))^(1/3) + ((1 > /2 ((9 - @69))))^(1/3)/3^(2/3) + x)))) + ((1/3 - > 1/3 ((25/2 - (3 @69)/2))^(1/3) - ((2/(3 > ((9 - @69)))))^(1/3) - ((1/2 ((9 - @69))))^(1/3)/3 > ^(2/3) - 1/3 ((1/2 ((25 + 3 @69))))^(1/3) - > 2 ((1/24 ((864 - 96 @69))^(1/3) + ((1/2 > ((9 + @69))))^(1/3)/(2 3^(2/3)))) + > x + (((-((2/(3 ((9 - @69)))))^(1/3)) - > ((1/2 ((9 - @69))))^(1/3)/3^(2/3))) x))/(((((-(1 > /3)) + 1/3 ((25/2 - (3 @69)/2))^(1/3) + > 1/3 ((1/2 ((25 + 3 @69))))^(1/3) + > (((-((2/(3 ((9 - @69)))))^(1/3)) - ((1/2 ((9 - > @69))))^(1/3)/3^(2/3)))^2 - > 2 (((-((2/(3 ((9 - @69)))))^(1/3)) - > ((1/2 ((9 - @69))))^(1/3)/3^(2/3))) ((1/24 ((864 > - 96 @69))^(1/3) + ((1/2 ((9 + @69))))^(1/3)/(2 > 3^(2/3)))))) ((1/3 - > 1/3 ((25/2 - (3 @69)/2))^(1/3) - > 1/3 ((1/2 ((25 + 3 @69))))^(1/3) + > 2 ((1/24 ((864 - 96 @69))^(1/3) + ((1/2 > ((9 + @69))))^(1/3)/(2 3^(2/3)))) x - > x^2)))))], Output] > }, Closed]], > > Cell[We could have found the inexact form directly., Text], > > Cell[CellGroupData[{ > > Cell[BoxData[ > (PartialFractionsR[((1 + x))/((x^3 - x + 1)) // N, > x])], Input], > > Cell[BoxData[ > ((-(0.07614206365252976`/(((1.324717957244746`)( > [InvisibleSpace])) + > 1.` x))) + (((0.7982664819556426`)( > [InvisibleSpace])) + 0.07614206365252976` > x)/(((0.754877666246693`)([InvisibleSpace])) - > 1.324717957244746` x + 1.` x^2))], Output] > }, Open ]] > }, Closed]] > }, Open ]] > }, > ScreenRectangle->{{0, 1024}, {0, 709}}, > AutoGeneratedPackage->None, > WindowSize->{534, 628}, > WindowMargins->{{199, Automatic}, {0, Automatic}}, > ShowCellLabel->False, > StyleDefinitions -> Default.nb > ] > > XXX > -- > Allan > > --------------------- > Allan Hayes > Mathematica Training and Consulting > Leicester UK > www.haystack.demon.co.uk > hay@haystack.demon.co.uk > Voice: +44 (0)116 271 4198 > > >> Greetings MathGroup, >> >> My name is Steve Earth, and I am a new subscriber to this list and >> also a >> new user of Mathematica; so please forgive this rather simple >> question... >> >> I would like to enter the quartic x^4 + x^3 + x^2 + x + 1 into >> Mathematica > >> and have it be able to tell me that it factors into >> >> (x^2 + GoldenRatio x + 1) ( x^2 - 1/GoldenRatio x + 1) >> >> What instructions do I need to execute to achieve this output? >> >> -Steve Earth >> Harker School >> http://www.harker.org/ >> > > > > > > > > ==== In my earlier posting I used Union and SameTest to replace two equivalent answers (arising form the symmetry of the equation) by a single one. However, the way I did, while givign the right answer, it makes little logical sense since in general applying Expand would make any factorizations the same leaving us always with just a single one. WIthout using Union at all we get: (a + b*x + x^2)*(c + d*x + x^2) /. Select[SolveAlways[x^4 + x^3 + x^2 + x + 1 == (a + b*x + x^2)*(c + d*x + x^2), x], FreeQ[#1, I] & ] {(1 + (1/2 - Sqrt[5]/2)*x + x^2)* (1 + (1/2)*(1 + Sqrt[5])*x + x^2), (1 + (1/2)*(1 - Sqrt[5])*x + x^2)* (1 + (1/2)*(1 + Sqrt[5])*x + x^2)} Since having two identical answers differing only in the way they are written out is a bit of a nuisance, a way to get rid of one of them which does not suffer from the illogicality of my first approach is: Union[(a + b*x + x^2)*(c + d*x + x^2) /. Select[SolveAlways[x^4 + x^3 + x^2 + x + 1 == (a + b*x + x^2)*(c + d*x + x^2), x], FreeQ[#1, I] & ], SameTest -> (Simplify[First[#1] == First[#2]] & )] {(1 + (1/2)*(1 - Sqrt[5])*x + x^2)* (1 + (1/2)*(1 + Sqrt[5])*x + x^2)} > There is an equivalent approach that will give the answer without > knowing it in advance. All we need to know is that any quartic can be > factored over the reals as a product of two quadratics, so: > > > Union[(a + b*x + x^2)*(c + d*x + x^2) /. > Select[SolveAlways[x^4 + x^3 + x^2 + x + 1 == > (a + b*x + x^2)*(c + d*x + x^2), x], FreeQ[#1, I] & ], > SameTest -> (Expand[#1] == Expand[#2] & )] > > > {(1 + (1/2)*(1 - Sqrt[5])*x + x^2)* > (1 + (1/2)*(1 + Sqrt[5])*x + x^2)} > > > Andrzej Kozlowski > Toyama International University > JAPAN > http://sigma.tuins.ac.jp/~andrzej/ > > > > > >> Steve >> The notebook given after NOTEBOOK below contains functions for >> factoring and >> partial fractioning. >> Here is an application to your problem: the first stage avoids our >> needing >> to know anything about the answer. >> >> fc=FactorR[x^4+x^3+x^2+x+1,x] >> >> (1 - (1/2)*(-1 - Sqrt[5])*x + x^2)* >> (1 - (1/2)*(-1 + Sqrt[5])*x + x^2) >> >> Now we need to get rid of Sqrt[5] in terms of GoldenRatio. >> This is rather messy: >> >> Simplify/@(fc/. Sqrt[5][Rule]2 GoldenRatio-1) >> >> (1 + x - GoldenRatio*x + x^2)*(1 + GoldenRatio*x + x^2) >> >> Simplify/@(%/.-GoldenRatio[Rule] 1/GoldenRatio -1) >> >> (1 + x/GoldenRatio + x^2)*(1 + GoldenRatio*x + x^2) >> >> >> Another example >> >> PartialFractionsR[(1 + x)x/(1 - 3*x + x^2), x] >> >> 1 - (2*(-1 + 4*x))/((3 + Sqrt[5] - 2*x)*(-3 + 2*x)) + >> (2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt[5] + 2*x)) >> >> Simplify[%] >> >> (x*(1 + x))/(1 - 3*x + x^2) >> >> NOTEBOOK: to make a notebook from the following, copy from the next >> line to >> the line preceding XXX and paste into a new Mathematica notebook. >> >> Notebook[{ >> >> Cell[CellGroupData[{ >> Cell[Factors and PartialFractions, Subtitle], >> >> Cell[Allan Hayes, 16 August 2001, Text], >> >> Cell[< >> Here are some functions for factoring and expressing in partial >> fractions over the reals and over the complex numbers. >> >, Text], >> >> Cell[BoxData[ >> (Quit)], Input], >> >> Cell[BoxData[{ >> (Off[General::spell1, General::spell]), n, >> ((FactorC::usage = > polynomial in x with complex coefficients, gives its factorization >> over the complex numbers.n >> The output may include Root objects which may be evaluated with >> ToRadicals or N.>;)n), n, >> ((FactorR::usage = > polynomial in x with real coefficients, gives its factorization over >> the reals.n >> The output may include Root objects which may be evaluated with >> ToRadicals or N.>;)n), n, >> ((PartialFractionsC::usage = > where ratl is a rational in x with complex coefficients, gives its >> factorization over the complex numbers.n >> The output may include Root objects which may be evaluated with >> ToRadicals or N.>;)n), n, >> ((PartialFractionsR::usage = > where ratl is a rational in x with real coefficients, gives its >> factorization over the real numbers.n >> The output may include Root objects which may be evaluated with >> ToRadicals or N.>;)), n, >> (On[General::spell1, General::spell])}], Input, >> InitializationCell->True], >> >> Cell[TextData[{ >> FactorC[p_, x_] := , >> StyleBox[(*over complex numbers*), >> FontFamily->Arial, >> FontWeight->Plain], >> nTimes @@ Cases[Roots[p == 0, x, n Cubics -> False], u_ == >> v_ -> x - v]n nFactorR[p_, x_] := , >> StyleBox[(*over reals, coefficients must be real*), >> FontFamily->Arial, >> FontWeight->Plain], >> n (Times @@ Join[Cases[#1, u_ == v_ /; Im[v] == 0 :> n x >> >> - v], Cases[#1, u_ == v_ /; Im[v] > 0 :> n x^2 - x*2*Re[v] + >> Abs[v]^2]] & )[n Roots[p == 0, x, Cubics -> False]] >> }], Input, >> InitializationCell->True], >> >> Cell[TextData[{ >> PartialFractionsC[p_, x_] := , >> StyleBox[(*over complex numbers*), >> FontFamily->Arial, >> FontWeight->Plain], >> n(#+Apart[#2/FactorC[#3,x]])&@@Flatten[{PolynomialReduce[#,#2], >> #2}]&[Numerator[#],Denominator[#]]&[Together[p]]n n >> PartialFractionsR[p_, x_] := , >> StyleBox[(*over reals, coefficients must be real*), >> FontFamily->Arial, >> FontWeight->Plain], >> n(#+Apart[#2/FactorR[#3,x]])&@@Flatten[{PolynomialReduce[#,#2], >> #2}]&[Numerator[#],Denominator[#]]&[Together[p]] >> }], Input, >> InitializationCell->True], >> >> Cell[CellGroupData[{ >> >> Cell[PROGRAMMING NOTES, Subsubsection], >> >> Cell[TextData[{ >> The option , >> StyleBox[Cubics->False, >> FontFamily->Courier], >> is used to keep the roots of cubics in , >> StyleBox[Root[....], >> FontFamily->Courier], >> form. This is better for computation.n, >> StyleBox[Re[v], >> FontFamily->Courier], >> and , >> StyleBox[Abs[v]^2, >> FontFamily->Courier], >> are used rather than , >> StyleBox[v+Conjugate[v] , >> FontFamily->Courier], >> and , >> StyleBox[v*Conjugate[v], >> FontFamily->Courier], >> to prevent , >> StyleBox[Apart, >> FontFamily->Courier], >> from factorising , >> StyleBox[x^2 - x*2*Re[v] + Abs[v]^2], >> FontFamily->Courier], >> back to complex form. >> }], Text] >> }, Closed]], >> >> Cell[CellGroupData[{ >> >> Cell[EXAMPLES, Subsubsection], >> >> Cell[pol = Expand[(x - 1)*(x + 1)^2*(x^2 + x + 1)^2*(x^2 + 4)]; , >> Input], >> >> Cell[CellGroupData[{ >> >> Cell[f1 = FactorC[pol, x], Input], >> >> Cell[BoxData[ >> ((((-1) + x)) (((-2) [ImaginaryI] + >> x)) ((2 [ImaginaryI] + >> x)) ((1 + x))^2 (((((-1)))^(1/3) + x))^2 >> (((-(((-1)))^(2/3)) + x))^2)], Output] >> }, Open ]], >> >> Cell[CellGroupData[{ >> >> Cell[f2 = FactorR[pol, x], Input], >> >> Cell[BoxData[ >> ((((-1) + x)) ((1 + x))^2 ((4 + >> x^2)) ((1 + x + x^2))^2)], Output] >> }, Open ]], >> >> Cell[CellGroupData[{ >> >> Cell[f3 = FactorR[x^3 + x + 1, x], Input], >> >> Cell[BoxData[ >> (((x - Root[1 + #1 + #1^3 &, 1])) ((x^2 - >> 2 x Root[(-1) + 2 #1 + 8 #1^3 &, 1] + >> Root[(-1) - #1^4 + #1^6 &, 2]^2)))], Output] >> }, Open ]], >> >> Cell[< >> Root objects appear because of the option Cubics->False in Roots. >> We can sometimes get radical forms, but notice the complication. >> >, Text], >> >> Cell[CellGroupData[{ >> >> Cell[ToRadicals[f3], Input], >> >> Cell[BoxData[ >> (((((2/(3 (((-9) + @93)))))^(1/3) - ((1/2 >> (((-9) + @93))))^(1/3)/3^(2/3) + x)) ((1/3 + >> 1/3 ((29/2 - (3 @93)/2))^(1/3) + >> 1/3 ((1/2 ((29 + 3 @93))))^(1/3) - >> 2 ((((1/2 ((9 + @93))))^(1/3)/(2 >> 3^(2/3)) - >> 1/(2^(2/3) ((3 ((9 + >> @93))))^(1/3)))) x + x^2)))], Output] >> }, Open ]], >> >> Cell[Inexact forms can be found, from f3 :, Text], >> >> Cell[CellGroupData[{ >> >> Cell[N[f3], Input], >> >> Cell[BoxData[ >> (((((0.6823278038280193`)([InvisibleSpace])) + >> x)) ((((1.4655712318767682`)([InvisibleSpace])) - >> 0.6823278038280193` x + x^2)))], Output] >> }, Open ]], >> >> Cell[or directly, Text], >> >> Cell[CellGroupData[{ >> >> Cell[f3 = FactorR[x^3 + x + 1//N, x], Input], >> >> Cell[BoxData[ >> (((((0.6823278038280193`)([InvisibleSpace])) + >> x)) ((((1.4655712318767682`)([InvisibleSpace])) - >> 0.6823278038280193` x + x^2)))], Output] >> }, Open ]], >> >> Cell[Partial fractions, Text], >> >> Cell[CellGroupData[{ >> >> Cell[pf1 = PartialFractionsR[(2 + x)/pol, x], Input], >> >> Cell[BoxData[ >> (1/(60 (((-1) + x))) - 1/(10 ((1 + x))^2) - >> 39/(100 ((1 + x))) + ((-54) - 31 x)/(4225 ((4 + >> x^2))) + ((-1) + 3 x)/(13 ((1 + x + x^2))^2) + (44 + >> >> 193 x)/(507 ((1 + x + x^2))))], Output] >> }, Open ]], >> >> Cell[CellGroupData[{ >> >> Cell[pf2 = PartialFractionsR[(1 + x)x/(1 - 3*x + x^2), x], >> Input], >> >> Cell[< >> 1 - (2*(-1 + 4*x))/((3 + Sqrt[5] - 2*x)*(-3 + 2*x)) + >> (2*(-1 + 4*x))/((-3 + 2*x)*(-3 + Sqrt[5] + 2*x)) >> >, Output] >> }, Open ]], >> >> Cell[CellGroupData[{ >> >> Cell[BoxData[ >> (Simplify[%])], Input], >> >> Cell[(x*(1 + x))/(1 - 3*x + x^2), Output] >> }, Open ]], >> >> Cell[Partial fractions will often involve Root objects , Text], >> >> Cell[CellGroupData[{ >> >> Cell[pf3 = PartialFractionsR[(1 + x)/(x^3 - x + 1), x], Input], >> >> Cell[BoxData[ >> (((1 + >> Root[1 - #1 + #1^3 &, >> 1]))/((((x - >> Root[1 - #1 + #1^3 &, >> 1])) ((Root[1 - #1 + #1^3 &, 1]^2 - >> 2 Root[1 - #1 + #1^3 &, >> 1] Root[(-1) - 2 #1 + 8 #1^3 &, 1] + >> Root[(-1) + #1^4 + #1^6 &, 2]^2)))) + ((x + >> Root[1 - #1 + #1^3 &, 1] + >> x Root[1 - #1 + #1^3 &, 1] - >> 2 Root[(-1) - 2 #1 + 8 #1^3 &, 1] - >> Root[(-1) + #1^4 + #1^6 &, 2]^2))/(((((-x^2) + >> 2 x Root[(-1) - 2 #1 + 8 #1^3 &, 1] - >> Root[(-1) + #1^4 + #1^6 &, 2]^2)) ((Root[1 - >> #1 + #1^3 &, 1]^2 - >> 2 Root[1 - #1 + #1^3 &, >> 1] Root[(-1) - 2 #1 + 8 #1^3 &, 1] + >> Root[(-1) + #1^4 + #1^6 &, 2]^2)))))], >> Output] >> }, Open ]], >> >> Cell[This can in fact be put in radical form:, Text], >> >> Cell[CellGroupData[{ >> >> Cell[ToRadicals[pf3], Input], >> >> Cell[BoxData[ >> (((1 - ((2/(3 ((9 - @69)))))^(1/3) - ((1/2 ((9 >> - @69))))^(1/3)/3^(2/3)))/(((((-(1/3)) + >> 1/3 ((25/2 - (3 @69)/2))^(1/3) + >> 1/3 ((1/2 ((25 + 3 @69))))^(1/3) + >> (((-((2/(3 ((9 - @69)))))^(1/3)) - ((1/2 ((9 - >> @69))))^(1/3)/3^(2/3)))^2 - >> 2 (((-((2/(3 ((9 - @69)))))^(1/3)) - >> ((1/2 ((9 - @69))))^(1/3)/3^(2/3))) ((1/24 ((864 >> - 96 @69))^(1/3) + ((1/2 ((9 + @69))))^(1/3)/(2 >> 3^(2/3)))))) ((((2/(3 ((9 - @69)))))^(1/3) + ((1 >> /2 ((9 - @69))))^(1/3)/3^(2/3) + x)))) + ((1/3 - >> 1/3 ((25/2 - (3 @69)/2))^(1/3) - ((2/(3 >> ((9 - @69)))))^(1/3) - ((1/2 ((9 - @69))))^(1/3)/3 >> ^(2/3) - 1/3 ((1/2 ((25 + 3 @69))))^(1/3) - >> 2 ((1/24 ((864 - 96 @69))^(1/3) + ((1/2 >> ((9 + @69))))^(1/3)/(2 3^(2/3)))) + >> x + (((-((2/(3 ((9 - @69)))))^(1/3)) - >> ((1/2 ((9 - @69))))^(1/3)/3^(2/3))) x))/(((((-(1 >> /3)) + 1/3 ((25/2 - (3 @69)/2))^(1/3) + >> 1/3 ((1/2 ((25 + 3 @69))))^(1/3) + >> (((-((2/(3 ((9 - @69)))))^(1/3)) - ((1/2 ((9 - >> @69))))^(1/3)/3^(2/3)))^2 - >> 2 (((-((2/(3 ((9 - @69)))))^(1/3)) - >> ((1/2 ((9 - @69))))^(1/3)/3^(2/3))) ((1/24 ((864 >> - 96 @69))^(1/3) + ((1/2 ((9 + @69))))^(1/3)/(2 >> 3^(2/3)))))) ((1/3 - >> 1/3 ((25/2 - (3 @69)/2))^(1/3) - >> 1/3 ((1/2 ((25 + 3 @69))))^(1/3) + >> 2 ((1/24 ((864 - 96 @69))^(1/3) + ((1/2 >> >> ((9 + @69))))^(1/3)/(2 3^(2/3)))) x - >> x^2)))))], Output] >> }, Closed]], >> >> Cell[We could have found the inexact form directly., Text], >> >> Cell[CellGroupData[{ >> >> Cell[BoxData[ >> (PartialFractionsR[((1 + x))/((x^3 - x + 1)) // N, >> x])], Input], >> >> Cell[BoxData[ >> ((-(0.07614206365252976`/(((1.324717957244746`)( >> [InvisibleSpace])) + >> 1.` x))) + (((0.7982664819556426`)( >> [InvisibleSpace])) + 0.07614206365252976` >> x)/(((0.754877666246693`)([InvisibleSpace])) - >> 1.324717957244746` x + 1.` x^2))], Output] >> }, Open ]] >> }, Closed]] >> }, Open ]] >> }, >> ScreenRectangle->{{0, 1024}, {0, 709}}, >> AutoGeneratedPackage->None, >> WindowSize->{534, 628}, >> WindowMargins->{{199, Automatic}, {0, Automatic}}, >> ShowCellLabel->False, >> StyleDefinitions -> Default.nb >> ] >> >> XXX >> -- >> Allan >> >> --------------------- >> Allan Hayes >> Mathematica Training and Consulting >> Leicester UK >> www.haystack.demon.co.uk >> hay@haystack.demon.co.uk >> Voice: +44 (0)116 271 4198 >> >> > Greetings MathGroup, > > My name is Steve Earth, and I am a new subscriber to this list and > also a > new user of Mathematica; so please forgive this rather simple > question... > > I would like to enter the quartic x^4 + x^3 + x^2 + x + 1 into > Mathematica >> > and have it be able to tell me that it factors into > > (x^2 + GoldenRatio x + 1) ( x^2 - 1/GoldenRatio x + 1) > > What instructions do I need to execute to achieve this output? > > -Steve Earth > Harker School > http://www.harker.org/ > >> >> >> >> >> >> >> >> > > Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ Reply-To: ==== Let's be realistic. If you want 60 digits of precision, too bad! -- in the real world. There's nothing we can measure that closely. Drug concentrations in clinical trials are generally measured within 15%, for instance. Even machine precision is more than can be realistically expected in any application I can think of. Even getting a satellite to Jupiter probably involves more error in the final result than machine precision. (If not, it's because we rely on ongoing corrections and natural factors that put the satellite where it should be, such as gravity drawing it toward each rendezvous -- not on that kind of precision in propulsion or guidance.) So... unless all numerics in a problem have a theoretical origin, and could be represented in Mathematica as Infinite precision expressions... all this talk of higher-precision computation seems futile. The realistic question is this: given that I have confidence, say, in 6 digits of precision for the inputs of an expression, how many digits can I trust in the end result? Giving inputs MORE precision than they deserve isn't the best way to answer that question. Here are two methods of answering it in Mathematica. One uses bignums and the other uses Intervals. Repetitious trial and error are NOT required either way. BIGNUMS: ClearAll[a, b, f, x, y] f = x*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + y*b^8 + a/(2*b); a = SetPrecision[77617, 6]; b = SetPrecision[33096, 6]; x = SetPrecision[33375/100, 6]; y = SetPrecision[55/10, 6]; InputForm[f] -4.1396`-12.5121*^19 Several previous solutions have set the precision or accuracy of f before giving a and b (and possibly x and y) values. That results in making the exponents imprecise along with all coefficients (not just x and y), which may or may not be what we want. INTERVALS: I'll first digress to figure out what Interval is equivalent to 6-digit precision. You might not actually do this if you like the Interval method, but you have to decide SOMEHOW what Interval width to use. nums = {77617, 33096, 33375/100, 55/10}; (Interval[SetPrecision[#1, 6]] & ) /@ nums /. Interval[{a_, b_}] :> 2*((b - a)/(b + a)); InputForm[%] {3.2209438653903`0.207*^-6, 3.7768914672467`0.2761*^-6, 2.9260299625467`0.1652*^-6, 2.7743252840909`0.1421*^-6} For these numbers, # + Interval[{-1,1}]*#/630000& gets us very close, so I'll use that. The second method therefore is: g = #1 + Interval[{-1, 1}]*(#1/630000) & ; a = g[77617]; b = g[33096]; x = g[333.75]; y = g[5.5]; f = x*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + y*b^8 + a/(2*b) (Min[f] + Max[f])/2 Interval[{-2.136361928005054*^32, 2.1363651195928296*^32}] 1.5957938878075177*^26 Either method shows the answer has no trustworthy digits, but I think the second result is far easier to interpret. Here's another example, using the Sin function, whose derivative is Cos, whose magnitude is bounded by one. The precision of the Sin of a number should be GREATER than the precision of the number itself, especially when Cos is small. a = SetPrecision[Pi/2, 6]; InputForm[Sin[a]] 0.9999999999990905052982256654`11.6078 a = g[N[Pi/2]]; Sin[a] - 1 Interval[{-3.1084024243455137*^-12, 0}] I hope this was worthwhile to someone. DrBob -----Original Message----- >[...] > > I would say this is correct and show that > SetPrecision is very useful > indeed. It tells you (what of course you ought > to already know in this > case anyway) that machine precision will not > give you a realiable > answer in this case. If you know your numbers > with a great deal of > accuracy you can get an accurate answer: > > In[24]:= > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - > b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > a=SetPrecision[77617.,100]; b = > SetPrecision[33096.,100]; > > > In[26]:= > {f, Precision[f]} > > Out[26]= > > {-0.82739605994682136814116509547981629199903311578438481991 > 781484167246798617832`61.2597, 61} > > > Congratulations! You just requested accuracy of > 100 for f and got 61 ( > to convince yourself add Accuracy[f] to In[26]). > If In[24] one > replaces SetAccuracy by SetPrecision the result is > similar. > > PK > [...] > > One has (initially) an accuracy of 100 for an > expression that contains > variables. > > In[25]:= Clear[a,b,f] > > In[26]:= f = SetAccuracy[333.75*b^6 + > a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > > In[27]:= Accuracy[f] > Out[27]= 100. > > Now we assign values to some indeterminants in f. > > In[28]:= a = SetPrecision[77617.,100]; b = > SetPrecision[33096.,100]; > > In[29]:= {f, Precision[f], Accuracy[f]} > Out[29]= > {-0.8273960599468213681411650954798162919990331157843848199178148, > > 61.2599, 61.3422} > > The precision and accuracy has dropped. This is all > according to > standard numerical analysis regarding cancellation > error. You'll find it > in any textbook on the topic. > Assume that I want accuracy and precision of 100 for f. You advice me to make experiments to find out, what should be the initial precision and accuracy of a and b to reach the requested accuracy and precision for f. Notice, that you cannot just repeat I[26], we saw already what happens. I have to re-type I[24], I[25], I[26], I[27], I[28], and I[29] as many times as needed to get f with accuracy and precision 100. Dan, you simply advocate to do MANUAL WORK that should be done by machine. Let's suppose that in the above example I just want 60 digits not 61. Precisely, I want 60 digits and nothing or zeros afterwards. Let's see if I could use SetAccuracy. In[30]:= SetAccuracy[%, 60] Out[30]= -0.82739605994682136814116509547981629199903311578438481991781 In[31]:= % // FullForm Out[30]//FullForm= -0.827396059946821368141165095479816291999033115784384819917814841672467 988` 59.9177 Oops, it did not work (as expected). Let's highlight with mouse the expression in Out[30] and copy to a new cell. Oops, we got -0.827396059946821368141165095479816291999033115784384819917814841672467 988` 59.9177 again. Let's change Out[30] to a text cell and then copy. In[31]:= -0.82739605994682136814116509547981629199903311578438481991781 Out[31]= -0.82739605994682136814116509547981629199903311578438481991781 Success? Not so fast. In[32]:= % // FullForm Out[32]//FullForm= -0.827396059946821368141165095479816291999033115784384819917809999999999 998635 08`59.2041 Dan, is there any simple way to get what I want? As I repeated already number of times, at this stage of the development of computer technology, software should do it for me (!). We both know that this is doable. Some of the textbooks that you just advised me to read describe it. As a developer of Mathematica, tell us why do you consider this to be a bad idea? Peter Kosta > As for what happens when you artificially raise > precision (or accuracy) > of machine numbers far beyond that guaranteed by > their internal > representation, that falls into to category of > garbage in, garbage out. > It is, howoever, valid to use SetPrecision to raise > precision in > (typically iterative) algorithms where significance > arithmetic might be > unduly pessimistic due to incorrect assumptions > about uncorollatedness > of numerical error. Examples of such usage have > appeared in this news > group. > > > Daniel Lichtblau > Wolfram Research __________________________________________________ Do you Yahoo!? http://faith.yahoo.com ==== Bobby, The example that I gave in my previous posting does not make my point, or it makes it in rather a hidden way, but it does show something interesting about computation with bigfloats. I'll explain what I mean by this and then give an example that does make the point directly. First, the previous example: Sin[#1]*10^#1*Log[1+10^(-#1)]&[15.9] -0.336629 Sin[#1]*10^#1*Log[1+10^(-#1)]&[SetPrecision[15.9,20]] Precision[%] -0.190858581374189370 17.7558 Sin[#1]*10^#1*Log[1+10^(-#1)]&[SetPrecision[15.9,7]] Precision[%] -0.19086 4.70309 (**) It looks as if the internal computations must be to a higher precision than 4 and that they start at SetPrecision[15.9,7]//FullForm 15.9000000000000003553`7 With MaxError = 10^-Accuracy[sp]//FullForm 1.590000000000001`*^-6 Roughly speaking, not more than the first seven digits are asserted to be correct. Now, the new example (taken from Stan Wagon, Programming Tips, Mathematica in Education and Research Volume 7, Number 2, 1988 p50) Clear[x] ser= Normal[Series[Cos[x],{x,0,200}]]; x= 75.0; ser//FullForm -2.7019882604300525`*^15 Probably not reliable. Set precision to 20: x= SetPrecision[75.0, 20]; (a=ser)//FullForm -16928.799183047`1.4688 MaxError= 10^-Accuracy[a] 575.263 Not good enough. Raise the precision to x= SetAccuracy[75.0,40]; (a=ser)//FullForm 1.0807905977573169155`7.7627 MaxError = 10^-Accuracy[a] !(1.3999657487996298`*^-6) That is 1.3999657487996298 10^-6 Good enough Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 ==== Bobby, You note some important points but there are situations in which raising accuracy is a practical necessity. 1) It may be that a calculation (perhaps describing a real world phenonenon) necessitates our raising the precision of inuts so as to work to high precision internally even when the output is not very sensitive to changes in input. Compare the following graphs pts = Table[({#1, Sin[#1]*10^#1*Log[1 + 10^(-#1)]} & )[x], {x, 15., 20., 0.1}]; ListPlot[pts, PlotJoined -> True] pts = Table[({#1, Sin[#1]*10^#1*Log[1 + 10^(-#1)]} & )[ SetAccuracy[x, 20]], {x, 15., 20., 0.1}]; ListPlot[pts, PlotJoined -> True] 2) Another situation in which high precision numbers are needed is when a computation with exact numbers would be slow or might use up all the memory available. We then need to replace the exact numbers with high precision bigfloats which causes the number of digits used internally to be restricted and the maximum error in the output to be reported. The N function will raise the precision of the exact numbers to try and reach the requested precision. There are also concerns with, for example, how the replacing bigfloats are related to the original numbers. How important this depends on the use to which the calculation is being put and how sensitive the output is to changes in inputs - in the plotting above it is not important. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Let's be realistic. If you want 60 digits of precision, too bad! -- in > the real world. There's nothing we can measure that closely. Drug > concentrations in clinical trials are generally measured within 15%, for > instance. Even machine precision is more than can be realistically > expected in any application I can think of. Even getting a satellite to > Jupiter probably involves more error in the final result than machine > precision. (If not, it's because we rely on ongoing corrections and > natural factors that put the satellite where it should be, such as > gravity drawing it toward each rendezvous -- not on that kind of > precision in propulsion or guidance.) > > So... unless all numerics in a problem have a theoretical origin, and > could be represented in Mathematica as Infinite precision expressions... > all this talk of higher-precision computation seems futile. > > The realistic question is this: given that I have confidence, say, in 6 > digits of precision for the inputs of an expression, how many digits can > I trust in the end result? Giving inputs MORE precision than they > deserve isn't the best way to answer that question. Here are two > methods of answering it in Mathematica. One uses bignums and the > other uses Intervals. > > Repetitious trial and error are NOT required either way. > > BIGNUMS: > > ClearAll[a, b, f, x, y] > f = x*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + y*b^8 + a/(2*b); > a = SetPrecision[77617, 6]; > b = SetPrecision[33096, 6]; > x = SetPrecision[33375/100, 6]; > y = SetPrecision[55/10, 6]; > InputForm[f] > > -4.1396`-12.5121*^19 > > Several previous solutions have set the precision or accuracy of f > before giving a and b (and possibly x and y) values. That results in > making the exponents imprecise along with all coefficients (not just x > and y), which may or may not be what we want. > > INTERVALS: > > I'll first digress to figure out what Interval is equivalent to 6-digit > precision. You might not actually do this if you like the Interval > method, but you have to decide SOMEHOW what Interval width to use. > > nums = {77617, 33096, 33375/100, 55/10}; > (Interval[SetPrecision[#1, 6]] & ) /@ nums /. Interval[{a_, b_}] :> > 2*((b - a)/(b + a)); > InputForm[%] > > {3.2209438653903`0.207*^-6, > 3.7768914672467`0.2761*^-6, > 2.9260299625467`0.1652*^-6, > 2.7743252840909`0.1421*^-6} > > For these numbers, # + Interval[{-1,1}]*#/630000& gets us very close, so > I'll use that. The second method therefore is: > > g = #1 + Interval[{-1, 1}]*(#1/630000) & ; > a = g[77617]; > b = g[33096]; > x = g[333.75]; > y = g[5.5]; > f = x*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + y*b^8 + a/(2*b) > (Min[f] + Max[f])/2 > > Interval[{-2.136361928005054*^32, 2.1363651195928296*^32}] > > 1.5957938878075177*^26 > > Either method shows the answer has no trustworthy digits, but I think > the second result is far easier to interpret. > > Here's another example, using the Sin function, whose derivative is Cos, > whose magnitude is bounded by one. The precision of the Sin of a number > should be GREATER than the precision of the number itself, especially > when Cos is small. > > a = SetPrecision[Pi/2, 6]; > InputForm[Sin[a]] > > 0.9999999999990905052982256654`11.6078 > > a = g[N[Pi/2]]; > Sin[a] - 1 > > Interval[{-3.1084024243455137*^-12, 0}] > > I hope this was worthwhile to someone. > > DrBob > > -----Original Message----- > > > > > On Friday, October 4, 2002, at 06:01 PM, DrBob > >[...] > > I would say this is correct and show that > SetPrecision is very useful > indeed. It tells you (what of course you ought > to already know in this > case anyway) that machine precision will not > give you a realiable > answer in this case. If you know your numbers > with a great deal of > accuracy you can get an accurate answer: > > In[24]:= > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - > b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > a=SetPrecision[77617.,100]; b = > SetPrecision[33096.,100]; > > > In[26]:= > {f, Precision[f]} > > Out[26]= > > > {-0.82739605994682136814116509547981629199903311578438481991 > 781484167246798617832`61.2597, 61} > > > Congratulations! You just requested accuracy of > 100 for f and got 61 ( > to convince yourself add Accuracy[f] to In[26]). > If In[24] one > replaces SetAccuracy by SetPrecision the result is > similar. > > PK > [...] > > One has (initially) an accuracy of 100 for an > expression that contains > variables. > > In[25]:= Clear[a,b,f] > > In[26]:= f = SetAccuracy[333.75*b^6 + > a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > > In[27]:= Accuracy[f] > Out[27]= 100. > > Now we assign values to some indeterminants in f. > > In[28]:= a = SetPrecision[77617.,100]; b = > SetPrecision[33096.,100]; > > In[29]:= {f, Precision[f], Accuracy[f]} > Out[29]= > > {-0.8273960599468213681411650954798162919990331157843848199178148, > > 61.2599, 61.3422} > > The precision and accuracy has dropped. This is all > according to > standard numerical analysis regarding cancellation > error. You'll find it > in any textbook on the topic. > > > Assume that I want accuracy and precision of 100 for > f. You advice me to make experiments to find out, what > should be the initial precision and accuracy of a and > b to reach the requested accuracy and precision for f. > Notice, that you cannot just repeat I[26], we saw > already what happens. I have to re-type I[24], I[25], > I[26], I[27], I[28], and I[29] as many times as needed > to get f with accuracy and precision 100. > > Dan, you simply advocate to do MANUAL WORK that should > be done by machine. > > Let's suppose that in the above example I just want 60 > digits not 61. Precisely, I want 60 digits and nothing > or zeros afterwards. Let's see if I could use > SetAccuracy. > > In[30]:= > SetAccuracy[%, 60] > > Out[30]= > -0.82739605994682136814116509547981629199903311578438481991781 > > In[31]:= > % // FullForm > > Out[30]//FullForm= > -0.827396059946821368141165095479816291999033115784384819917814841672467 > 988` > 59.9177 > > Oops, it did not work (as expected). Let's highlight > with mouse the expression in Out[30] and copy to a new > cell. Oops, we got > -0.827396059946821368141165095479816291999033115784384819917814841672467 > 988` > 59.9177 > again. Let's change Out[30] to a text cell and then > copy. > > In[31]:= > -0.82739605994682136814116509547981629199903311578438481991781 > > Out[31]= > -0.82739605994682136814116509547981629199903311578438481991781 > > Success? Not so fast. > > In[32]:= > % // FullForm > > Out[32]//FullForm= > -0.827396059946821368141165095479816291999033115784384819917809999999999 > 998635 > 08`59.2041 > > Dan, is there any simple way to get what I want? > > As I repeated already number of times, at this stage > of the development of computer technology, software > should do it for me (!). We both know that this is > doable. Some of the textbooks that you just advised me > to read describe it. As a developer of Mathematica, > tell us why do you consider this to be a bad idea? > > Peter Kosta > > As for what happens when you artificially raise > precision (or accuracy) > of machine numbers far beyond that guaranteed by > their internal > representation, that falls into to category of > garbage in, garbage out. > It is, howoever, valid to use SetPrecision to raise > precision in > (typically iterative) algorithms where significance > arithmetic might be > unduly pessimistic due to incorrect assumptions > about uncorollatedness > of numerical error. Examples of such usage have > appeared in this news > group. > > > Daniel Lichtblau > Wolfram Research > > > __________________________________________________ > Do you Yahoo!? > http://faith.yahoo.com > > > > Reply-To: ==== Here's a start, with a more complicated function: lst = Range[50]; f = #1^2 & ; k = 7; r = Range[k + 1, Length[lst], k]; lst[[r]] = lst[[r]] + f /@ lst[[r - 1]]; lst {1, 2, 3, 4, 5, 6, 7, 57, 9, 10, 11, 12, 13, 14, 211, 16, 17, 18, 19, 20, 21, 463, 23, 24, 25, 26, 27, 28, 813, 30, 31, 32, 33, 34, 35, 1261, 37, 38, 39, 40, 41, 42, 1807, 44, 45, 46, 47, 48, 49, 2451} or: g[lst_List, k_Integer?Positive, f_Function] := Module[ {result = lst, r = Range[k + 1, Length[lst], k]}, result[[r]] = result[[r]] + f /@ lst[[r - 1]]; result ] lst = Range[50]; lst = g[lst, 7, #1^2 & ] or: lst = Range[50]; lst + Drop[Prepend[MapIndexed[If[Mod[First@#2, k] == 0, f@#1, 0] &, lst], 0], -1] DrBob -----Original Message----- advantage of native List operators, but still not be too recondite? I've been thinking about multiplying a copy of myList by a mask list {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. Better ways??? ==== I'm playing around with Mathematica just trying to see what happens if... One thing I came up with was lst1={a,b,c}; lst2={d,e,f}; Map[lst1,lst2} which resulted in the following rather unusual looking expression(?): {{a, b, c}[d], {a, b, c}[e], {a, b, c}[f]} I'm wondering if such a List represents something 'meaningful'. Any opinions? STH . ==== > I'm playing around with Mathematica just trying to see what happens if... One thing > I came up with was lst1={a,b,c}; lst2={d,e,f}; Map[lst1,lst2} which > resulted in the following rather unusual looking expression(?): > > {{a, b, c}[d], {a, b, c}[e], {a, b, c}[f]} > > I'm wondering if such a List represents something 'meaningful'. Any > opinions? Through /@ {{a, b, c}[d], {a, b, c}[e], {a, b, c}[f]} {{a[d], b[d], c[d]}, {a[e], b[e], c[e]}, {a[f], b[f], c[f]}} which might be useful. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 ==== >I want to apply a function to every k-th element of a long list and >add the result to the k+1 element. > >[Actually k = 3 and I just want to multiply myList[[k]] by a >constant (independent of k) and add the result to myList[[k+1]] for >every value of k that's divisible by 3.] lst = Table[Random[], {20}] fact = 2 Here's a matrix method. f represents an indexed element of a matrix. f[x_,x_] := If[Mod[x,3]==0, fact, 1] f[x_, y_] := If[Mod[x,3]==0&&y[Equal]x+1, 2, 0] Create a matrix from the elements. arr = Array[f,{Length[lst], Length[lst]}]; Then matrix multiply. newlst1 = lst.arr Here's another way with the highly underrated MapIndexed. Create pairs of the nth and n-1th values. pairs = Transpose[{lst, Prepend[Drop[lst,-1],0]}] Create a function that takes the nth value (val), the n-1th value (prevval), and the index (num). multlst[{val_, prevval_}, {num_}] := Switch[Mod[num, 3], 0, fact*val, 1,val+ fact*prevval, 2, val ] Then, MapIndexed across the pairs. newlst2=MapIndexed[multlst, pairs] -------------------------------------------------------------- Omega Consulting The final answer to your Mathematica needs Spend less time searching and more time finding. http://www.wz.com/internet/Mathematica.html ==== I have two equations that I have solved for: x[n_] := 2331 + 8 n y[n_] := -3108 - 11n I want to include only solutions which are non-negative, that is x >= 0 and y >= 0. In this example we can do 2331 + 8n > = 0 and solve for n, n >= -291.375 and -3108 - 11 n >= 0 and solve for n, n <= -282.545 So we have -291.375 <= n <= -282.545. The integer solution set here is for n = {-290, -289, -288, -287, -286, -285, -284, -283}. So in this case we have 8 non-negative solutions. Given that I can supply x[n] and y[n], how do I go about finding the set n? ==== Here is a way of doing what you want (output cells are indented): <=0,y[n]>=0},n] -(2331/8) <= n <= -(3108/11) FullForm[soln] Inequality[Rational[-2331,8],LessEqual,n,LessEqual,Rational[-3108,11]] Range[Apply[Sequence,{Ceiling[soln[[1]]],Floor[soln[[-1]]]}]] {-291, -290, -289, -288, -287, -286, -285, -284, -283} -- Steve Luttrell West Malvern, UK > > I have two equations that I have solved for: > > x[n_] := 2331 + 8 n > y[n_] := -3108 - 11n > > I want to include only solutions which are non-negative, that is x >= 0 and > y >= 0. > > In this example we can do 2331 + 8n > = 0 and solve for n, n >= -291.375 > and -3108 - 11 n >= 0 and solve for n, n <= -282.545 > > So we have -291.375 <= n <= -282.545. > > The integer solution set here is for n = > {-290, -289, -288, -287, -286, -285, -284, -283}. > > So in this case we have 8 non-negative solutions. > > Given that I can supply x[n] and y[n], how do I go about finding the set n? > > > > ==== Let's first consider your original problem and take a small list as an example: mylist = {a, b, c, d, e, f, g}; As you pointed out there is a rather obvious and natural way to do it using the Do loop. In[5]:= Do[mylist[[3*i + 1]] = k*mylist[[3*i]] + mylist[[3*i + 1]], {i, 1, Length[mylist]/3}]; mylist Out[5]= {a, b, c, d + c*k, e, f, g + f*k} One can also do it using something like your second approach. Notice the need to re-set mylist which got changed by the Do loop: In[6]:= mylist={a,b,c,d,e,f,g}; In[7]:= RotateRight[Table[If[Mod[i,3]==0,k, 0],{i,1,Length[mylist]}]*mylist]+mylist Out[7]= {a,b,c,d+c k,e,f,g+f k} There is an ambiguity that appears if the length of the list is exactly divisible by 3. In that case k times the last element should be added to the next element. In this case the first approach (using Do) will produce an error message while the second will interpret the next element to mean the first element of the list. One can fix that but I shan't bother to do so and assume that the length of the list is not divisible by 3. Now let's take a large list and compare the performance of the two approaches: In[8]:= k = 2; In[9]:= mylist = Table[Random[Integer, {1, 9}], {10000}]; In[11]:= mylist1 = mylist; In[12]:= Timing[list1 = (Do[mylist[[3*i + 1]] = k*mylist[[3*i]] + mylist[[3*i + 1]], {i, 1, Length[mylist]/3}]; mylist); ] Out[12]= {0.21999999999999997*Second, Null} In[13]:= mylist = mylist1; In[14]:= Timing[list2 = RotateRight[Table[If[Mod[i, 3] == 0, k, 0], {i, 1, Length[mylist]}]*mylist] + mylist; ] Out[14]= {0.020000000000000018*Second, Null} In[15]:= list1 == list2 Out[15]= True So you were right, at least in this implementation the second approach turns out to be much faster. Note also however, that when you change the problem to the one that you originally stated the two approaches will no longer give the same answer. The reason is that your statement is ambiguous: apply a function to every k-th element of a long list and add the result to the k+1 element can either mean that you want to take the original k-th element of the original list, multiply by a constant and add to the next one, or do the same with the already altered k-th element (by the previous step of the procedure). The Do loop approach will do the latter and the other the former. Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > I want to apply a function to every k-th element of a long list and > add the result to the k+1 element. > > [Actually k = 3 and I just want to multiply myList[[k]] by a > constant (independent of k) and add the result to myList[[k+1]] for > every value of k that's divisible by 3.] > > Is there a way to do this -- or in general to get at every k-th > element of a list -- that's faster and more elegant than writing a > brute > force Do[] loop or using Mod[] operators, and that will take > advantage of native List operators, but still not be too recondite? > > I've been thinking about multiplying a copy of myList by a mask > list > {0,0,1,0,0,1,..} to generate a masked copy and approaches like that. > Better ways??? > > > ==== Can Mathematica factor the polynomial p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; without a priori knowledge of the Extension field? ==== Carlos, Futher to my previous posting (which gave the code for the function FactorR used below), here is a complete factorisation by radicals. I also test that the product of the factors gives the original polynomial. We want to factor the polynomial p1 = x^6 + (9/14)*x^5 + (9/28)*x^4 + (3/35)*x^3 + (9/700)*x^2 + (9/8750)*x + 3/87500; in radicals. We can't expect this to be easy or even possible in terms of radicals (the general quintic is not solvable interms of radicals). But, using the function FactorR given in my posting, Re:factoring quartic over radicals, sent a few days ago (08/012/02) , we get p2 = FactorR[p1, x] (x^2 - 2*x*Root[3 + 45*#1 + 225*#1^2 + 700*#1^3 & , 1] + Root[-3 + 225*#1^2 - 5625*#1^4 + 87500*#1^6 & , 2]^2)* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 2] + Root[9 - 1350*#1^2 + 84375*#1^4 - 3056250*#1^6 - 11250000*#1^8 - 984375000*#1^10 + 7656250000*#1^12 & , 3]^2)* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 1] + Root[9 - 1350*#1^2 + 84375*#1^4 - 3056250*#1^6 - 11250000*#1^8 - 984375000*#1^10 + 7656250000*#1^12 & , 4]^2) Try to change the root objects to radical form: p3 = p2 /. r_Root :> ToRadicals[r] (3/140 + (1/140)*(13/5)^(2/3)*3^(1/3) - (1/140)*(13/5)^(1/3)*3^(2/3) - 2*(-(3/28) - (1/28)*(13/5)^(2/3)*3^(1/3) + (1/28)*(13/5)^(1/3)*3^(2/3))*x + x^2)*(x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 2] + Root[9 - 1350*#1 + 84375*#1^2 - 3056250*#1^3 - 11250000*#1^4 - 984375000*#1^5 + 7656250000*#1^6 & , 1])* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 1] + Root[9 - 1350*#1 + 84375*#1^2 - 3056250*#1^3 - 11250000*#1^4 - 984375000*#1^5 + 7656250000*#1^6 & , 2]) We succeeded with the first factor: f1 = p3[[1]] 3/140 + (1/140)*(13/5)^(2/3)*3^(1/3) - (1/140)*(13/5)^(1/3)*3^(2/3) - 2*(-(3/28) - (1/28)*(13/5)^(2/3)*3^(1/3) + (1/28)*(13/5)^(1/3)*3^(2/3))*x + x^2 The product of the other two factors, in a form avoiding root objects, is easily found by division: q = PolynomialQuotient[p1, f1, x] 3/3500 + ((13/5)^(1/3)*3^(2/3))/3500 + (3/175 + (1/175)*(13/5)^(1/3)*3^(2/3))*x + (9/70 - (1/140)*(13/5)^(2/3)*3^(1/3) + (1/28)*(13/5)^(1/3)*3^(2/3))*x^2 + (3/7 - (1/14)*(13/5)^(2/3)*3^(1/3) + (1/14)*(13/5)^(1/3)*3^(2/3))*x^3 + x^4 Try FactorR on this f23 = FactorR[q, x] (x^2 + ((-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920] + Im[(1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)*15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2)/ 1225000000 - (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))* ((2250 - 25*13^(2/3)*15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/ 306250000)))/(4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)*3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/3920])]])^2 - 2*x*((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + Re[(1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)*15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2)/ 1225000000 - (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))* ((2250 - 25*13^(2/3)*15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/ 306250000)))/(4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)*3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/3920])]]) + ((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + Re[(1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)*15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2)/ 1225000000 - (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))* ((2250 - 25*13^(2/3)*15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/ 306250000)))/(4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)*3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/3920])]])^2)* (x^2 + ((1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920] + Im[(-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)*15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2)/ 1225000000 + (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))* ((2250 - 25*13^(2/3)*15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/ 306250000)))/(4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)*3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/3920])]])^2 - 2*x*((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + Re[(-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)*15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2)/ 1225000000 + (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))* ((2250 - 25*13^(2/3)*15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/ 306250000)))/(4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)*3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/3920])]]) + ((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + Re[(-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)*15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2)/ 1225000000 + (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))* ((2250 - 25*13^(2/3)*15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/ 306250000)))/(4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)*3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/3920])]])^2) We try to get rid of the parts Re[.] and Im[.]:, f231 = f23 /. z:(_Re | _Im) :> ToRadicals[FullSimplify[z]] (((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 - (1/280)*Sqrt[3*(-390 + 13*13^(2/3)*15^(1/3) + 15*13^(1/3)*15^(2/3))])^2 + ((1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920] + (1/280)*Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)])^2 - 2*((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 - (1/280)*Sqrt[3*(-390 + 13*13^(2/3)*15^(1/3) + 15*13^(1/3)*15^(2/3))])*x + x^2)*(((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + (1/280)*Sqrt[3*(-390 + 13*13^(2/3)*15^(1/3) + 15*13^(1/3)*15^(2/3))])^2 + ((-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)*3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920] + (1/280)*Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)])^2 - 2*((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + (1/280)*Sqrt[3*(-390 + 13*13^(2/3)*15^(1/3) + 15*13^(1/3)*15^(2/3))])*x + x^2) We now have the ramaining two factors in radical form, but a little simplification helps: f232 = f231 /. (n_)?NumericQ :> Simplify[n] ((1/78400)*(30 - 13^(2/3)*15^(1/3) + 13^(1/3)*15^(2/3) + Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)])^2 + (1/78400)*(Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)] + Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)])^2 - (1/140)*(-30 + 13^(2/3)*15^(1/3) - 13^(1/3)*15^(2/3) - Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)])*x + x^2)* ((1/78400)*(-30 + 13^(2/3)*15^(1/3) - 13^(1/3)*15^(2/3) + Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)])^2 + (1/78400)*(Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)] - Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)])^2 - (1/140)*(-30 + 13^(2/3)*15^(1/3) - 13^(1/3)*15^(2/3) + Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)])*x + x^2) TEST Test if the product of the factors is equal to p1: prd1 = Collect[Expand[f232*f1], x] 172077/3841600000 - (4959*(13/5)^(2/3)*3^(1/3))/768320000 + (117*(13/5)^(1/3)*3^(2/3))/27440000 - (1/1920800000)* (3*Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]* Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]* Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]) + (1/3841600000)*((13/5)^(1/3)*3^(2/3)*Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]*Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]*Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]) + (491193/384160000 - (7731*(13/5)^(2/3)*3^(1/3))/76832000 + (117*(13/5)^(1/3)*3^(2/3))/2744000 - (1/384160000)* (9*Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]* Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]* Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]) - (1/384160000)*((13/5)^(2/3)*3^(1/3)*Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]*Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]*Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]) + (1/192080000)*((13/5)^(1/3)*3^(2/3)* Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]* Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]* Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]))*x + (1087173/76832000 - (12771*(13/5)^(2/3)*3^(1/3))/30732800 + (5967*(13/5)^(1/3)*3^(2/3))/30732800 - (1/76832000)* (9*Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]* Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]* Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]) - (1/153664000)*(3*(13/5)^(2/3)*3^(1/3)*Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]*Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]*Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]) + (1/153664000)*(3*(13/5)^(1/3)*3^(2/3)* Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]* Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]* Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]))*x^2 + (23871/274400 - (99*(13/5)^(2/3)*3^(1/3))/109760 + (663*(13/5)^(1/3)*3^(2/3))/ 548800 - (1/2744000)*(Sqrt[1170 + 45*13^(2/3)*15^(1/3) + 39*13^(1/3)*15^(2/3)]*Sqrt[-1170 + 39*13^(2/3)*15^(1/3) + 45*13^(1/3)*15^(2/3)]*Sqrt[1170 + 73*13^(2/3)*15^(1/3) + 67*13^(1/3)*15^(2/3)]))*x^3 + (9*x^4)/28 + (9*x^5)/14 + x^6 prd1 /. (n_)?NumericQ :> ToRadicals[FullSimplify[n]] 172077/3841600000 - (4959*(13/5)^(2/3)*3^(1/3))/768320000 + (117*(13/5)^(1/3)*3^(2/3))/27440000 - (9*(234 + 221*(13/5)^(1/3)*3^(2/3) - 33*13^(2/3)*15^(1/3)))/384160000 + (117*(-165 + 17*13^(2/3)*15^(1/3) + 6*13^(1/3)*15^(2/3)))/3841600000 + (9*x)/8750 + (9*x^2)/700 + (3*x^3)/35 + (9*x^4)/28 + (9*x^5)/14 + x^6 Together[%] (3 + 90*x + 1125*x^2 + 7500*x^3 + 28125*x^4 + 56250*x^5 + 87500*x^6)/87500 Apart[%] 3/87500 + (9*x)/8750 + (9*x^2)/700 + (3*x^3)/35 + (9*x^4)/28 + (9*x^5)/14 + x^6 This is p1: p1 3/87500 + (9*x)/8750 + (9*x^2)/700 + (3*x^3)/35 + (9*x^4)/28 + (9*x^5)/14 + x^6 ------------------ It is ususlly better to try to reduce a difference to zero than to reduce one form to another tst1 = Collect[Expand[f232*f1 - p1], x] tst2 = tst1 /. (n_)?NumericQ :> ToRadicals[FullSimplify[n]] 8073/768320000 - (4959*(13/5)^(2/3)*3^(1/3))/768320000 + (117*(13/5)^(1/3)*3^(2/3))/27440000 - (9*(234 + 221*(13/5)^(1/3)*3^(2/3) - 33*13^(2/3)*15^(1/3)))/384160000 + (117*(-165 + 17*13^(2/3)*15^(1/3) + 6*13^(1/3)*15^(2/3)))/3841600000 Together[%] 0 -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Can Mathematica factor the polynomial > > p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; > > without a priori knowledge of the Extension field? > ==== Carlos, p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; We can't expect this to be easy or even possible in terms of radicals (the general quintic is not solvable interms of radicals). But, using the function FactorR given in my posting, Re:factoring quartic over radicals, sent a few days (08/012/02) ago, we get p2=FactorR[p1,x] (x^2 - 2*x*Root[3 + 45*#1 + 225*#1^2 + 700*#1^3 & , 1] + Root[-3 + 225*#1^2 - 5625*#1^4 + 87500*#1^6 & , 2]^2)* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 2] + Root[9 - 1350*#1^2 + 84375*#1^4 - 3056250*#1^6 - 11250000*#1^8 - 984375000*#1^10 + 7656250000*#1^12 & , 3]^2)* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 1] + Root[9 - 1350*#1^2 + 84375*#1^4 - 3056250*#1^6 - 11250000*#1^8 - 984375000*#1^10 + 7656250000*#1^12 & , 4]^2) Try to express the factors in terms of radicals p3=ToRadicals/@p2 (3/140 + (1/140)*(13/5)^(2/3)*3^(1/3) - (1/140)*(13/5)^(1/3)*3^(2/3) - 2*(-(3/28) - (1/28)*(13/5)^(2/3)*3^(1/3) + (1/28)*(13/5)^(1/3)*3^(2/3))*x + x^2)* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 2] + Root[9 - 1350*#1 + 84375*#1^2 - 3056250*#1^3 - 11250000*#1^4 - 984375000*#1^5 + 7656250000*#1^6 & , 1])* (x^2 - 2*x*Root[1827 + 65340*#1 + 974700*#1^2 + 7824000*#1^3 + 36360000*#1^4 + 100800000*#1^5 + 156800000*#1^6 & , 1] + Root[9 - 1350*#1 + 84375*#1^2 - 3056250*#1^3 - 11250000*#1^4 - 984375000*#1^5 + 7656250000*#1^6 & , 2]) We succeeded with the first factor f1=p3[[1]] 3/140 + (1/140)*(13/5)^(2/3)*3^(1/3) - (1/140)*(13/5)^(1/3)*3^(2/3) - 2*(-(3/28) - (1/28)*(13/5)^(2/3)*3^(1/3) + (1/28)*(13/5)^(1/3)*3^(2/3))*x + x^2 The product of the other two factors, in a form avoiding root objects, is easily found: q=PolynomialQuotient[p1,f1,x] 3/3500 + ((13/5)^(1/3)*3^(2/3))/3500 + (3/175 + (1/175)*(13/5)^(1/3)*3^(2/3))*x + (9/70 - (1/140)*(13/5)^(2/3)*3^(1/3) + (1/28)*(13/5)^(1/3)*3^(2/3))*x^2 + (3/7 - (1/14)*(13/5)^(2/3)*3^(1/3) + (1/14)*(13/5)^(1/3)*3^(2/3))*x^3 + x^4 5*(3 + 10*x*(6 + 5*x*(9 + 10*x*(3 + 7*x))))) Try FactorR on this f23=FactorR[q,x] (x^2 + ((-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920] + Im[(1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)* 15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)* 15^(2/3))^2)/1225000000 - (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))*((2250 - 25*13^(2/3)* 15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/306250000)))/ (4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)* 3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/ 3920])]])^2 - 2*x*((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + Re[(1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)* 15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)* 15^(2/3))^2)/1225000000 - (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))*((2250 - 25*13^(2/3)* 15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/306250000)))/ (4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)* 3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/ 3920])]]) + ((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)* 15^(2/3))/70000 + Re[(1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)* 15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)* 15^(2/3))^2)/1225000000 - (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))*((2250 - 25*13^(2/3)* 15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/306250000)))/ (4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)* 3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/ 3920])]])^2)* (x^2 + ((1/2)*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920] + Im[(-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)* 15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)* 15^(2/3))^2)/1225000000 + (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))*((2250 - 25*13^(2/3)* 15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/306250000)))/ (4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)* 3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/ 3920])]])^2 - 2*x*((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)*15^(2/3))/70000 + Re[(-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)* 15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)* 15^(2/3))^2)/1225000000 + (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))*((2250 - 25*13^(2/3)* 15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/306250000)))/ (4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)* 3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/ 3920])]]) + ((-7500 + 250*13^(2/3)*15^(1/3) - 250*13^(1/3)* 15^(2/3))/70000 + Re[(-(1/2))*Sqrt[117/1960 + (9/784)*(13/5)^(2/3)* 3^(1/3) + (39*(13/5)^(1/3)*3^(2/3))/3920 + (-2250 + 25*13^(2/3)*15^(1/3) - 125*13^(1/3)* 15^(2/3))/8750 + (3*(7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)* 15^(2/3))^2)/1225000000 + (-((2*(300 + 20*13^(1/3)*15^(2/3)))/4375) + (1/17500)*((7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))*((2250 - 25*13^(2/3)* 15^(1/3) + 125*13^(1/3)*15^(2/3))/4375 - (7500 - 250*13^(2/3)*15^(1/3) + 250*13^(1/3)*15^(2/3))^2/306250000)))/ (4*Sqrt[-(117/1960) - (9/784)*(13/5)^(2/3)* 3^(1/3) - (39*(13/5)^(1/3)*3^(2/3))/ 3920])]])^2) We still use Re and Im -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Can Mathematica factor the polynomial > > p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; > > without a priori knowledge of the Extension field? > ==== Dear MathGroup Experts, Is there a slick way to use Mathematica to plot the phase portrait of a pair of (straightforward) differential equations? I'd also like to see a plot of the associated vector/direction field. I found a good package called DynPac, but it's very cumbersome to use, and I was hoping there's another tool out there that my students would feel more comfortable using. Jason -- Jason Miller, Ph.D. Division of Mathematics and Computer Science Truman State University 100 East Normal St. Kirksville, MO 63501 http://vh216801.truman.edu 660.785.7430 ==== >I have two equations that I have solved for: > >x[n_] := 2331 + 8 n >y[n_] := -3108 - 11n > >I want to include only solutions which are non-negative, that is x >= 0 >and >y >= 0. > >In this example we can do 2331 + 8n > = 0 and solve for n, n >= -291.375 >and -3108 - 11 n >= 0 and solve for n, n <= -282.545 > >So we have -291.375 <= n <= -282.545. > >The integer solution set here is for n = >{-290, -289, -288, -287, -286, -285, -284, -283}. > >So in this case we have 8 non-negative solutions. > >Given that I can supply x[n] and y[n], how do I go about finding the set >n? > Needs[Algebra`InequalitySolve`]; x[n_] := 2331 + 8n; y[n_] := -3108 - 11n; rng = InequalitySolve[{x[n] >= 0, y[n] >= 0}, n]; soln = Range[Ceiling[rng[[1]]], rng[[-1]]] {-291, -290, -289, -288, -287, -286, -285, -284, -283} Length[soln] 9 Bob Hanlon ==== Factoring without specifying the extension does not really make sense. Of course Mathematica can easily factor yur polynomial into linear factors over the complex numbers (with the help of Solve), but I suspect you are really asking for is factoring over the reals. This is harder and needs more human input. But anyway, Mathematica can do this, or at least I have done it using Mathematica. In fact if you are satisfied with a numerical answer Mathematica can do alone and in seconds: In[1]:= Simplify[N[x^6 + (9/14)*x^5 + (9/28)*x^4 + (3/35)*x^3 + (9/700)*x^2 + (9/8750)*x + 3/87500]] Out[1]= 1.*(0.010974992601737198 + 0.20255610310498295*x + x^2)*(0.020476912388332692 + 0.2047691238833268*x + x^2)*(0.15256133957420948 + 0.23553191586883315*x + x^2) But I have in fact been foolish enough to compute the exact answer too. I do not propose to post it here for it's absolutely horrible (expressed in terms of Root objects) and quite useless. However if you really want to see it I can send it to you privately. Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > To: mathgroup@smc.vnet.net > > Can Mathematica factor the polynomial > > p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; > > without a priori knowledge of the Extension field? > > > ==== > > Can Mathematica factor the polynomial > > p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; > > without a priori knowledge of the Extension field? The endless sci.math.symbolic thread strikes MathGroup! Not exactly possible with no prior knowledge. Factor must work with a given field, and the default is the rationals. You might direct it, say by using the discriminant of the polynomial (as pointed out by Peter Montgomery and Stephen Forrest on sci.math.symbolic. One may do this in Mathematica as: p1 = x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; I cribbed code for Discriminant right from www.mathworld.com: Discriminant[p_?PolynomialQ,x_] := With[{n = Exponent[p,x]}, Cancel[((-1)^(n(n-1)/2)Resultant[p,D[p,x],x])/Coefficient[p,x,n]^(2n-1)]] In[3]:= InputForm[Factor[p1, Extension->Sqrt[Discriminant[p1,x]]]] Out[3]//InputForm= ((-15*I + Sqrt[195] - (225*I)*x + 15*Sqrt[195]*x - (1125*I)*x^2 + 75*Sqrt[195]*x^2 - (3500*I)*x^3)*(15*I + Sqrt[195] + (225*I)*x + 15*Sqrt[195]*x + (1125*I)*x^2 + 75*Sqrt[195]*x^2 + (3500*I)*x^3))/12250000 Daniel Lichtblau Wolfram Research ==== On second thoughts: any one who really wants to see what the exact answer is, can evaluate the following: sols = Select[{a, b} /. SolveAlways[ x^6 + (9/14)*x^5 + (9/28)*x^4 + (3/35)*x^3 + (9/700)*x^2 + (9/8750)*x + 3/87500 == (x^2 + a*x + b)*(x^4 + c*x^3 + d*x^2 + e*x + f), x], FreeQ[N[#1], _Complex] & ] Times @@ (Map[x^2 + {x, 1}.# &, sols]) N[%] (0.010974992601737203 + 0.20255610310498245*x + x^2)* (0.020476912388332696 + 0.20476912388332683*x + x^2)* (0.15256133957420942 + 0.23553164887424147*x + x^2) Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > Factoring without specifying the extension does not really make sense. > Of course Mathematica can easily factor yur polynomial into linear > factors over the complex numbers (with the help of Solve), but I > suspect you are really asking for is factoring over the reals. This is > harder and needs more human input. But anyway, Mathematica can do > this, or at least I have done it using Mathematica. In fact if you are > satisfied with a numerical answer Mathematica can do alone and in > seconds: > > In[1]:= > Simplify[N[x^6 + (9/14)*x^5 + (9/28)*x^4 + (3/35)*x^3 + (9/700)*x^2 + > (9/8750)*x + 3/87500]] > > Out[1]= > 1.*(0.010974992601737198 + 0.20255610310498295*x + > x^2)*(0.020476912388332692 + > 0.2047691238833268*x + x^2)*(0.15256133957420948 + > 0.23553191586883315*x + x^2) > > But I have in fact been foolish enough to compute the exact answer > too. I do not propose to post it here for it's absolutely horrible > (expressed in terms of Root objects) and quite useless. However if you > really want to see it I can send it to you privately. > > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ > > > > >> To: mathgroup@smc.vnet.net >> >> Can Mathematica factor the polynomial >> >> p1=x^6+9/14*x^5+9/28*x^4+3/35*x^3+9/700*x^2+9/8750*x+3/87500; >> >> without a priori knowledge of the Extension field? >> >> >> > > Reply-To: ==== Those aren't equations; they're functions, and we don't solve functions, we solve equations. What equations do you want to solve? DrBob -----Original Message----- and -3108 - 11 n >= 0 and solve for n, n <= -282.545 So we have -291.375 <= n <= -282.545. The integer solution set here is for n = {-290, -289, -288, -287, -286, -285, -284, -283}. So in this case we have 8 non-negative solutions. Given that I can supply x[n] and y[n], how do I go about finding the set n? ==== Is there a logically fundamental difference between functional and procedural programming? What I mean to ask is, can we do exactly the same thing with purely functional approaches as we can with purely procedural approaches? Is this basically the recursive verses iterative distinction? Why would one chose one approach over the other? STH . ==== > Let's be realistic. If you want 60 digits of precision, too bad! -- in > the real world. There's nothing we can measure that closely. Drug > concentrations in clinical trials are generally measured within 15%, for > instance. Even machine precision is more than can be realistically > expected in any application I can think of. Even getting a satellite to > Jupiter probably involves more error in the final result than machine > precision. (If not, it's because we rely on ongoing corrections and > natural factors that put the satellite where it should be, such as > gravity drawing it toward each rendezvous -- not on that kind of > precision in propulsion or guidance.) > > So... unless all numerics in a problem have a theoretical origin, and > could be represented in Mathematica as Infinite precision expressions... > all this talk of higher-precision computation seems futile. ...Except in the very rare instance when one needs to do intermediate calculations with, e.g., 60 digits of precision in order to get only a few correct digits of the final answer. The length of this thread is surely proof of the need for a definitive reference on the topic. Has there been a Mathematica-centered numerical analysis book published since Skeel & Keiper? --- Selwyn Hollis ==== > In[24]:= > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > a=SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; > > In[26]:= > {f, Precision[f]} > > Out[26]= > {-0.82739605994682136814116509547981629199903311578438481991 > 781484167246798617832`61.2597, 61} > > Congratulations! You just requested accuracy of > 100 for f and got 61 ( > to convince yourself add Accuracy[f] to In[26]). There is no request in that example for an accuracy of 100 in the result. The only request is for an accuracy of 100 in the input. > In[26]:= f = SetAccuracy[333.75*b^6 + > a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > > In[27]:= Accuracy[f] > Out[27]= 100. > > Now we assign values to some indeterminants in f. > > In[28]:= a = SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; > > In[29]:= {f, Precision[f], Accuracy[f]} > Out[29]= > {-0.8273960599468213681411650954798162919990331157843848199178148, > 61.2599, 61.3422} > > The precision and accuracy has dropped. This is all > according to > standard numerical analysis regarding cancellation > error. You'll find it in any textbook on the topic. > > > Assume that I want accuracy and precision of 100 for > f. You advice me to make experiments to find out, what > should be the initial precision and accuracy of a and > b to reach the requested accuracy and precision for f. > Notice, that you cannot just repeat I[26], we saw > already what happens. I have to re-type I[24], I[25], > I[26], I[27], I[28], and I[29] as many times as needed > to get f with accuracy and precision 100. > > Dan, you simply advocate to do MANUAL WORK that should > be done by machine. You do not have to do any of this manually. The machine (Mathematica) will do all of this, usually using built-in functions. The N function, for example, will automatically adjust the working precision to give you a precision that you request, provided that doing so doesn't involve making up arbitrary digits. The example above starts out with machine numbers (333.75, 5.5, etc.), uses SetPrecision and SetAccuracy to make up arbitrary digits to pad those numbers out to some specified number of digits, and then does some simple arithmetic. If the goal is to get some specified number of digits in the result, and it is ok to make up arbitrary digits like this to achieve that goal, then the only manual work required to achive that goal is to apply SetAccuracy or SetPrecision to the result, to tell the computer that that is what you want. > Let's suppose that in the above example I just want 60 > digits not 61. Precisely, I want 60 digits and nothing > or zeros afterwards. Let's see if I could use > SetAccuracy. > > In[30]:= SetAccuracy[%, 60] > > Out[30]= -0.82739605994682136814116509547981629199903311578438481991781 > > In[31]:= % // FullForm > > Out[30]//FullForm= > -0.827396059946821368141165095479816291999033115784384819917814841672467988` > 59.9177 > > Oops, it did not work (as expected). If you could explain what you were expecting I am sure there are many contributors to this group who could explain to you why it did not do that. > Let's highlight > with mouse the expression in Out[30] and copy to a new > cell. Oops, we got > -0.827396059946821368141165095479816291999033115784384819917814841672467988` > 59.9177 again. Let's change Out[30] to a text cell and then copy. > > In[31]:= -0.82739605994682136814116509547981629199903311578438481991781 > > Out[31]= -0.82739605994682136814116509547981629199903311578438481991781 > > Success? Not so fast. If you could describe what you were trying to achieve with all of that copying and pasting and such I am again sure that there are many contributors to this group who could describe how to do it. It is very unlikely that the process will involve any copying and pasting or detours through text cells. > In[32]:= > % // FullForm > > Out[32]//FullForm= > -0.82739605994682136814116509547981629199903311578438481991780999999999999863 5 > 08`59.2041 > > Dan, is there any simple way to get what I want? Probably the answer is yes, but you will have to describe more clearly what you want. > As I repeated already number of times, at this stage > of the development of computer technology, software > should do it for me (!). If what you want to do is get a certain number of digits in the result, and it is ok to make up arbitrary digits as in the examples above, then you can do that by simply applying SetPrecision or SetAccuracy to the result. If you want the computer to automatically adjust the working precision to give a certain precision in the result, you can do that using N. If you want something else, and you can describe what that is, then probably someone can describe how to get Mathematica to do that for you. Dave Withoff Wolfram Research ==== Putting in Print[Some header text, TableForm[ Table[----------]]] puts the header text and the Table in the same cell, but with a largish gap (3 lines?) between the text and the Table's header lines. Hardly a serious problem, pretty trivial in fact, but a bit ugly and seems as if it really shouldn't work this way. Any way to get rid of this? siegman@stanford.edu Reply-To: ==== The first problem is that ArcSin[x/10] isn't a left-inverse of 10 Sin[x] in the region of the root. That's why your code converges on another root. A better inverse for your purpose is the gi below: f = #(# + 3) &; g = 10Sin@# &; gi = Pi - ArcSin[#/10] &; Using that inverse, there's still a problem, though. Your approximation of the root with r = gi@f@r fails because the derivative of gi@f at the root is gi'[f@rr]f'[rr] -2.02342 That's greater than one in magnitude, so distance from the root is magnified rather than diminished. Instead, try r = fi@g@r Where fi[y_] := Evaluate[x /. Last@Solve[f@x == y, x]] This should work, since fi'[g@rr]g'[rr] -0.49421355442685166 Sure enough, it does work: Values = NestList[fi[g[#1]] & , 2., 12] {2., 1.8679332339369226, 1.9368280058437026, 1.9040490698559083, 1.9205018812387413, 1.9124384783620436, 1.916439313493727, 1.9144659935649395, 1.9154421880638148, 1.914959973607326, 1.915198347545482, 1.9150805538598723, 1.9151387724997768} (f[#1] - g[#1] & ) /@ values {0.9070257317431825, -0.4688124734947827, 0.2242366717647286, -0.11228304957089463, 0.05509675095190758, -0.02732121417963107, 0.0134795615740817, -0.006667318794729482, 0.003293718665990042, -0.0016281317372435211, 0.0008045637255396088, -0.00039764607942949226, 0.0001965172491082967} Absolute error is cut in half at each iteration, as expected with a derivative for fi@g near -1/2. The negative sign causes the error to alternate in sign. We can also look at the log-absolute value of the error as follows: (Log[Abs[f[#1] - g[#1]]] & ) /@ values {-0.09758445910053692, -0.7575524337892089, -1.4950532145264737, -2.18673236744676, -2.8986645309519163, -3.6000918023816326, -4.306580698204814, -5.010537479670821, -5.715738058891756, -6.420322094992857, -7.125210383308283, -7.829948195959684, -8.534760348785936} Rest[%] - Drop[%, -1] {-0.659967974688672, -0.7375007807372648, -0.6916791529202861, -0.7119321635051565, -0.7014272714297163, -0.7064888958231816, -0.7039567814660064, -0.7052005792209357, -0.7045840361011004, -0.7048882883154262, -0.704737812651401, -0.7048121528262516} The difference in logarithm of the absolute error approaches Log@Abs[fi'[g@rr]g'[rr]] -0.7047875587967565 If you want to use this for teaching, try to use as little code as possible -- as I have above -- and always try to avoid Do loops in Mathematica on principle. DrBob -----Original Message----- kenf Below is the code Clear[f, g, gi, lim, r, rr, fr, gir, a, b, c, d, conv]; Plot[{x * ((x + 3)), 10*Sin[x]}, {x, 0.01, 2.4}, PlotStyle -> {{RGBColor[1, 0, 0], Thickness[ .006]}, {RGBColor[0, 0, 1], Thickness[ .006]}} ]; rr = FindRoot[x * ((x + 3)) == 10*Sin[x], {x, 2, 0.01, 2.4}]; f[a_] := a * ((a + 3)) /; a > 0; g[b_] := 10. * Sin[b] /; b > 0; gi[c_] := ArcSin[0.1*c] /; c > 0; Print[Actual root is , rr]; lim = 10; r = 2.0; conv = 10^-4; For[i = 1, i < lim, i++, { fr = f[r]; gir = gi[fr]; d = Abs[N[gir] - r]; i If[d < conv, Break[]]; r = gir; Print[The value of x = , r, found after , i, iterations,, with a tolerence , d, n] } ] Print[The value of x = , r, found after , i, iterations,, with a tolerence , d, n] Every man, woman and responsible child has an unalienable individual, civil, Constitutional and human right to obtain, own, and carry, openly or concealed, any weapon -- rifle, shotgun, handgun, machine gun, anything -- any time, any place, without asking anyone's permission. L. Neil Smith ==== f[t_] = {t + Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]} So It's basically a vector whose coordinates are determined based on the values you pass in. Then I took the derivative by just typing f', which outputs {1 + Sqrt[3] Cos[#1], -2 Sin[#1], Sqrt[3] - Cos[#1]}& What I'd like to do is have Mathematica calculate the norm of this as it would any vector, so that I can play with the norm function. As it turns out, the norm in this case is identical to Sqrt[8], so it would be nice if Mathematica could figure that out. Is it possible to do this? ==== [My previous reply seems to have gone astray - at least it has not come back to me. Here is a slightly edited repeat] You have computed f[t_] = {t + Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]}; and then found f' {1 + Sqrt[3]*Cos[#1], -2*Sin[#1], Sqrt[3] - Cos[#1]} & To get the function for the norm of the derivative we can use norm = Evaluate/@(Simplify/@(Sqrt[#.#]&/@(f'))) 2*Sqrt[2] & We map the usual functions for calclulating and simplifying the norm inside Function[.] (which is the full form of (.)& and then map the function Evaluation to make the result evaluate -- this is needed since Function has the attribute HoldAll. Please note that the parentheses are essential. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > > f[t_] = {t + Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]} > > So It's basically a vector whose coordinates are determined based on the > values you pass in. > > Then I took the derivative by just typing f', which outputs > > {1 + Sqrt[3] Cos[#1], -2 Sin[#1], Sqrt[3] - Cos[#1]}& > > > What I'd like to do is have Mathematica calculate the norm of this as it > would any vector, so that I can play with the norm function. As it turns > out, the norm in this case is identical to Sqrt[8], so it would be nice if > Mathematica could figure that out. Is it possible to do this? > > > ==== > f[t_] = {t + Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]} > > So It's basically a vector whose coordinates are determined based on the > values you pass in. > > Then I took the derivative by just typing f', which outputs > > {1 + Sqrt[3] Cos[#1], -2 Sin[#1], Sqrt[3] - Cos[#1]}& > > > What I'd like to do is have Mathematica calculate the norm of this as it > would any vector, so that I can play with the norm function. I don't think whether the definition is prompt (=) or delayed (:=) is as important as supplied the argument [t] in In := Simplify[Sqrt[f'[t] . f'[t]]] Out = 2 Sqrt[2] Or you can construct a new pure function with In := Evaluate[Simplify[Sqrt[f'[#] . f'[#]]]]& Out = 2 Sqrt[2] & Of course, there is not much left to play with :) Tom Burton ==== >I want to apply a function to every k-th element of a long list and >add the result to the k+1 element. > >[Actually k = 3 and I just want to multiply myList[[k]] by a >constant (independent of k) and add the result to myList[[k+1]] for >every value of k that's divisible by 3.] If I understand what you are trying to do correctly, the following should work (f[#[[1]]+#[[2]])&/@Partition[Drop[list,k-1],2,k] Here f is the function you want applied to the k-th element ==== MathGroup/Mathematica Newsgroup users - in the past 24 hours or so and have not seen your post, please resend/repost it. Disk drive problems caused some of the posts in the queue to be lost. This has been fixed. Sorry for the delay. Steve Christensen Moderator ==== >Please allow me to summarize what I've learned in the recent discussion, and >retract my claim that Accuracy, Precision, and SetAccuracy are useless. >Numbers come in three varieties The technical term is flavors. >- machine precision, Infinite precision, >and bignum or bigfloat. Bignums and bigfloats (synonymous?) Actually bignums can also refer to integers too large to represent as machine integers. But I tend to use bignum when I really mean bigfloat, and I suspect this sloppy practice may be common. >aren't called that in the Help Browser, but they're the result of using >N[expr,k] or >SetAccuracy[expr,k] where k is bigger than machine precision. >If k <= machine precision, the result is a machine precision number, even >if you know the expression isn't that precise. >If, when you use N or SetAccuracy as described above, the expression >contains undefined symbols, you get an expression with all its numerics >replaced by bignums of the indicated precision. When the symbols are >defined later, if ANY of them are machine precision, the expression is >computed with machine arithmetic - with the side-effect that coefficients >that originally were Infinite-precision are now only machine precision. >That is, x^2 might have become x^2.0000000000000000000000000000000000 >but later became x^2., for instance. I think this is correct in cases where all symbolic stuff gets replaced by numeric values. In general there is a sort of coercion to lowest precision, with the caveat that machine floats pollute everything. >If all the symbols have been set to bignum or Infinite precision values, >the computation will be done taking precision into account, and the result >has a Precision or Accuracy that makes sense. In all other cases, >Precision returns Infinity for entirely Infinite-precision expressions >and 16 for everything else. I'm not sure I understand this last sentence. My interpretation: Computations that are exact will have infinite precision. Computations in machine arithmetic will claim a precision of 16. If that is what you are claiming, then yes, that's what Mathematica is doing (but see my last remarks). >When one of the experts says significance arithmetic that's what they >mean - using SetAccuracy or N to give things more than 16 digits, leaving >no machine precision numbers anywhere in the expression, and using Accuracy >or Precision, which ARE meaningful in that case, to judge the result. >(It's meaningful if all your inputs really have more than 16 digits of >precision, that is.) I'm as guilty as anyone else in this thread, perhaps more so, of being too loose with the technical jargon. Also I am not certain what version 4 makes of SetAccuracy/SetPrecision in terms of significance arithmetic. In the development kernel they will force everything in sight to have the indicated precision, whether justified or not. This may well introduce error even with exact input, e.g. in cases where intermediate computations would require higher precision in order to get an end result with the requested precision or accuracy. N[], on the other hand, will handle that and, except in pathological circumstances, will give a result with the correct precision. As another minor point, arbitrary precision numbers are simply (tautologically?) numbers that may have arbitrarily large precision (subject to software limitations). Significance arithmetic refers to a particular model of manipulating such numbers with a mechanism for tracking precision. There are other models, in particular fixed precision arithmetic; that we use the former, by default, is an occasional source of sturm und drang in this news group. I'm sure the distinction between arbitrary precision numbers and significance arithmetic has at least minor relevance to this thread, and I imagine I've helped to confuse the issue in some places by using the terms almost interchangeably. >You can't use significance arithmetic to determine how much precision a >result has if your inputs have 16 or 15 or 2 digits of precision. One can, if the numbers are really bignums (of low precision, naturally). What one cannot do at present is create such low precision numbers via N[]. >In the example we've been looking at, you can give the inputs MORE accuracy >than you really believe they have, and still get back 0 digits from >Precision at the end, so there are clearly no trustworthy digits when >you use the original inputs either. If an expression is on the razor's >edge, and has lost only a few digits of precision, that wouldn't work >so well. >Oddly enough, significance arithmetic in the Browser doesn't take you >to any of that. Instead, it takes you to Interval arithmetic, a more >sophisticated method, which may give a more accurate gauge of how much >precision you really have, and WILL deal with machine precision numbers >and numbers with even less precision. It does a very good job on the >example. However, it isn't very suitable for Complex numbers, matrices, >etc. NSolve and NIntegrate probably can't handle it, either. I have filed a suggestion in-house that the documentation on significance arithmetic take one to the section on arbitrary precision numbers (3.1.5), as that would be more appropriate. Note that that section, while primarily concerned with the significance arithmetic model, also briefly mentions fixed precision bignum arithmetic. >Daniel Lichtblau promises that all this will be clearer in the next release. I'm not sure I'd go that far. What I will claim is that the distinction between machine numbers and bignums will be more transparent to users. At present if one does, say, N[number,precision] then one will get a machine number if prec<=$MachinePrecision. We have made a change so that this will no longer be the case. I am not prepared to go into details at this time (sorry). Perhaps more important for everyday use, and certainly more pertinent for this thread, Precision[] will distinguish between bignums of 16 digits precision and machine numbers. Again, I have to defer on details. At the very least I think the pitfall of believing a claim of 16 digits precision for machine numbers will be removed. Daniel Lichtblau Wolfram Research ==== Bobby, One point: >.... bigfloats ... [are] the result of using N[expr,k] or SetAccuracy[expr,k] where k is bigger than machine precision. If k <= > machine > precision, the result is a machine precision number. We get bigfloats with k<=machine precision with SetAccuracy and SetPrecision but not with N: Example a=SetPrecision[2.3,5] 2.3000 Precision[a] 5. Precision[a^2000] 1.69897 Also, of course, when more than machine precision significant digits are given a=1.01234567891234500; Precision[a] 17.301 Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 Reply-To: ==== Please allow me to summarize what I've learned in the recent discussion, and retract my claim that Accuracy, Precision, and SetAccuracy are useless. Numbers come in three varieties - machine precision, Infinite precision, and bignum or bigfloat. Bignums and bigfloats (synonymous?) aren't called that in the Help Browser, but they're the result of using N[expr,k] or SetAccuracy[expr,k] where k is bigger than machine precision. If k <= machine precision, the result is a machine precision number, even if you know the expression isn't that precise. If, when you use N or SetAccuracy as described above, the expression contains undefined symbols, you get an expression with all its numerics replaced by bignums of the indicated precision. When the symbols are defined later, if ANY of them are machine precision, the expression is computed with machine arithmetic - with the side-effect that coefficients that originally were Infinite-precision are now only machine precision. That is, x^2 might have become x^2.0000000000000000000000000000000000 but later became x^2., for instance. If all the symbols have been set to bignum or Infinite precision values, the computation will be done taking precision into account, and the result has a Precision or Accuracy that makes sense. In all other cases, Precision returns Infinity for entirely Infinite-precision expressions and 16 for everything else. When one of the experts says significance arithmetic that's what they mean - using SetAccuracy or N to give things more than 16 digits, leaving no machine precision numbers anywhere in the expression, and using Accuracy or Precision, which ARE meaningful in that case, to judge the result. (It's meaningful if all your inputs really have more than 16 digits of precision, that is.) You can't use significance arithmetic to determine how much precision a result has if your inputs have 16 or 15 or 2 digits of precision. In the example we've been looking at, you can give the inputs MORE accuracy than you really believe they have, and still get back 0 digits from Precision at the end, so there are clearly no trustworthy digits when you use the original inputs either. If an expression is on the razor's edge, and has lost only a few digits of precision, that wouldn't work so well. Oddly enough, significance arithmetic in the Browser doesn't take you to any of that. Instead, it takes you to Interval arithmetic, a more sophisticated method, which may give a more accurate gauge of how much precision you really have, and WILL deal with machine precision numbers and numbers with even less precision. It does a very good job on the example. However, it isn't very suitable for Complex numbers, matrices, etc. NSolve and NIntegrate probably can't handle it, either. Daniel Lichtblau promises that all this will be clearer in the next release. DrBob ==== Deleting the browserindex.nb does not correct the online help e.g the online mathematica book is not fully accessable etc.Why are some of the *.nb files corrupted in the first place?It seems to occur only on win2k. > >Try deleting ... >Mathematica4.2DocumentationEnglishMainBookBrowserIndex.nb > > > > > > ==== If you follow this link, you will see what I have found out about this: http://forums.wolfram.com/student-support/topics/5709 Brian > Deleting the browserindex.nb does not correct the online help e.g the > online mathematica book is not fully accessable etc.Why are some of > the *.nb files corrupted in the first place?It seems to occur only on > win2k. > > >Try deleting ... >Mathematica4.2DocumentationEnglishMainBookBrowserIndex.nb > > > > > > > ==== > Is there a logically fundamental difference between functional and > procedural programming? What I mean to ask is, can we do exactly the > same > thing with purely functional approaches as we can with purely > procedural > approaches? > There is a fundamental difference, a strictly functional language does statement alone then it is obvious that there are some things that can be done in a procedural (nowadays people prefer to call them imperative) language that cannot be done in a functional language. On the other hand in imperative languages without pointers to procedures on cannot define a function which takes another function as an argument which functional languages allow. What you are probably really interested in is whether there exist a class of programs in the sense of a transformation on some input set into an output set which can be expressed in only one paradigm. Because nearly all major programming languages (SQL being the glaring exception) can implement a Turing Machine any algorithm which can be performed by a Turing Machine can be performed by any programming language, imperative or functional. So in principle functional and imperative languages are equivalently powerful although in practice it is easier to express some concepts in one paradigm or another. > Is this basically the recursive verses iterative distinction? > No. > Why would one chose one approach over the other? > In software engineering circles there is some evidence that the functional programming paradigm allows for efficient implementation of large programming projects, see http://www.math.chalmers.se/~rjmh/Papers/whyfp.html. Also it is possible to prove a strictly functional program correct because it cannot have side effects (no destructive updates of global states) which caused some excitement in academia but has not been a big selling point in industry. That said, by now you must realize that Mathematica is not a strictly functional language although you can use it as such. Actually Mathematica has a lot in common with LISP which is sometimes lumped together with the functional languages since it admits that programming style but both Mathematica and LISP are not pure (the desirability of purity being left to personal preference). One last advantage of functional programs though (which is related to the fact that they admit correctness proofs) is that it is relatively easy for a compiler/interpreter to optimize a functional program. This is why implicit iteration (Map in Mathematica) tends to outperform imperative style loops (Do, For, While etc.), which have to do a destructive update of the loop counter variable and therefore cannot reorganize a loop since statements in the loop may also destructively update the loop counter. C et al. get around this problem by being closely matched to the hardware. Ssezi ==== Hey folks, I have been working on a problem that seems to not lend itself to a solution. The following Mathematica code begins with the expression that I am trying to solve. For the curious, it's a degree 2 zonal and sectoral harmonics problem where I am trying to calculate and plot the geoid of earth as compared to an ellipse to see how well the geoid is approximated as an ellipse. In any case, we have the following relation ship, U =GM/r( 1 - (ae/r)^2 ( J2 (3/2 Sin[t]^2 - 1/2) - 3 Cos[t]^2 (C22 Cos[2 x] + S22 Sin[2 x])); Ur =1/2 we^2 (r Cos[t])^2; W[x_] =U + Ur; In trying to reorder W to become a function r wrt t, that is r[t_], I tried, among others, Solve[W[t], r] which returned ({{r -> Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, 1]}, {r -> Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, 2]}, {r -> Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, 3]}, {r -> Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, 4]}, {r -> Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, 5]}} ) which wasn't too much help, though it is a list of 5 Root functions. But in order to plot, I need a function r(t) so I can plot r wrt t...right? ParametricPlot[r[t], {t, 0, Pi}] So, I guess my questions are as follows: 1. How do I get Solve[ ] to output numbers, as //N and NSolve did nothing to Solve[r[t], ...] to get any numbers instead of just r -> Root[...]? 2. Is there a way to use ParametricPlot[ W[t], {t, 0.0, Pi}] instead of using r[t] and negating the whole issue of solving W[t] for r[t]? I have read that Solve only works for up to 4th order polynomials. I have been unable to find anything that works on my problem, having tried SolveAlways[ ] and other, and combination of others. Any help is welcome. I'll be glad to forward my Notebook if someone jdhouse4@mac.com Ph.D. Graduate Student Aerospace Engineering University of Texas at Austin 512-784-3205 ==== Try can use ImplicitPlot from the Graphics package. Janusz. > Hey folks, > > I have been working on a problem that seems to not lend itself to a > solution. The following Mathematica code begins with the expression > that I am trying to solve. For the curious, it's a degree 2 zonal and > sectoral harmonics problem where I am trying to calculate and plot the > geoid of earth as compared to an ellipse to see how well the geoid is > approximated as an ellipse. In any case, we have the following relation > ship, > > U =GM/r( 1 - (ae/r)^2 ( J2 (3/2 Sin[t]^2 - 1/2) - 3 Cos[t]^2 (C22 > Cos[2 x] + S22 Sin[2 x])); > Ur =1/2 we^2 (r Cos[t])^2; > W[x_] =U + Ur; > > In trying to reorder W to become a function r wrt t, that is r[t_], I > tried, among others, > > Solve[W[t], r] > > which returned > > ({{r -> > Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - > 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - > 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, > 1]}, {r -> > Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - > 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - > 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, > 2]}, {r -> > Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - > 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - > 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, > 3]}, {r -> > Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - > 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - > 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, > 4]}, {r -> > Root[ae^2 GM J2 + 6 ae^2 C22 GM Cos[ [t]] ^2 - > 3 ae^2 GM J2 Sin[ [t]] ^2 + 2 GM #1 ^2 - > 2 W0 #1 ^3 + we^2 Cos[ [t]] ^2 #1 ^5 &, 5]}} ) > > which wasn't too much help, though it is a list of 5 Root functions. > But in order to plot, I need a function r(t) so I can plot r wrt > t...right? > > ParametricPlot[r[t], {t, 0, Pi}] > > So, I guess my questions are as follows: > 1. How do I get Solve[ ] to output numbers, as //N and NSolve did > nothing to Solve[r[t], ...] to get any numbers instead of just r -> > Root[...]? > > 2. Is there a way to use ParametricPlot[ W[t], {t, 0.0, Pi}] instead of > using r[t] and negating the whole issue of solving W[t] for r[t]? > > I have read that Solve only works for up to 4th order polynomials. I > have been unable to find anything that works on my problem, having > tried SolveAlways[ ] and other, and combination of others. > > Any help is welcome. I'll be glad to forward my Notebook if someone > > jdhouse4@mac.com > > Ph.D. Graduate Student > Aerospace Engineering > University of Texas at Austin > > 512-784-3205 ==== Dear friends, I have build a table with this pattern: Flatten[{{{d, X, Y, Z}}, Table[{t, x[t], y[t], z[t]}, {t, 1, 10}], Table[{t, x[t], y[t], z[t]}, {t, 20, 100, 10}], Table[{t, x[t], y[t], z[t]}, {t, 200, 1000, 100}]}, 1] // TableForm I would like obtain the same Output in a more elegant way. In other word, how Can I avoid write Table[{t, x[t], y[t], z[t]} a few times. Thans Guillermo Sanchez --------------------------------------------- This message was sent using Endymion MailMan. Reply-To: kuska@informatik.uni-leipzig.de ==== Flatten[{{{d, X, Y, Z}}, Flatten[Table[{t, x[t], y[t], z[t]}, Evaluate[{t, Sequence @@ #}]] & /@ {{1, 10}, {20, 100, 10}, {200, 1000, 100}}, 1]}, 1] // TableForm ??? Jens > > Dear friends, > I have build a table with this pattern: > > Flatten[{{{d, X, Y, Z}}, > Table[{t, x[t], y[t], z[t]}, {t, 1, 10}], > Table[{t, x[t], y[t], z[t]}, {t, 20, 100, 10}], > Table[{t, x[t], y[t], z[t]}, {t, 200, 1000, 100}]}, 1] // TableForm > > I would like obtain the same Output in a more elegant way. In other word, how > Can I avoid write Table[{t, x[t], y[t], z[t]} a few times. > > Thans > > Guillermo > Sanchez > > --------------------------------------------- > This message was sent using Endymion MailMan. ==== > I would like obtain the same Output in a more elegant way. In other word, how > Can I avoid write Table[{t, x[t], y[t], z[t]} a few times. Table[{t=10^k; t, x[t], y[t], z[t]}, {k, 0, 3, 0.2}] or something similar. ==== Guillermo, Instead of Flatten[{{{d,X,Y,Z}},Table[{t,x[t],y[t],z[t]},{t,1,10}], Table[{t,x[t],y[t],z[t]},{t,20,100,10}], Table[{t,x[t],y[t],z[t]},{t,200,1000,100}]},1]; we can use Flatten[{{{{d,X,Y,Z}}}, Table[{t,x[t],y[t],z[t]},#]&/@{{t,1,10},{t,20,100,10},{t,200,1000, 100}}},2]; Test %===%% True -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Dear friends, > I have build a table with this pattern: > > Flatten[{{{d, X, Y, Z}}, > Table[{t, x[t], y[t], z[t]}, {t, 1, 10}], > Table[{t, x[t], y[t], z[t]}, {t, 20, 100, 10}], > Table[{t, x[t], y[t], z[t]}, {t, 200, 1000, 100}]}, 1] // TableForm > > I would like obtain the same Output in a more elegant way. In other word, how > Can I avoid write Table[{t, x[t], y[t], z[t]} a few times. > > Thans > > Guillermo > Sanchez > > --------------------------------------------- > This message was sent using Endymion MailMan. > > > ==== I have two seperate list questions that I was hoping to get help with. Question 1. I have a variable length list similar to that generated by FactorInteger, that is {number, exponent} pairs. An example follows. lista = {{2,3},{3,1},{5,1}} ... this is the number 2^3 * 3^1 * 5^1 I want to generate a list of all the products of numbers from this list. I can tell that I get a total (3+1)*(1+1)*(1+1) = 4*2*2 = 16, products and I want a list showing all of those. These would be: 2^3 can generate {2^0, 2^1, 2^2, 2^3} = {1, 2, 4 ,8} 3^1 can generate {3^0, 3^1} = {3} ... we dont care about the duplicate 1 5^1 can generate {5^0, 5^1} = {5} ... we dont care about the duplicate 1 Hence the 4*2*2 = 16 (the product of one more of the exponents) above. Next we should get 16 products (from these lists), namely (I left them as products below to show what I am after): {1, 2, 4, 8, 1*3, 2*3, 4*3, 8*3, 1*5, 2 * 5, 4* 5, 8* 5, 1*3*5, 2*3*5, 4*3*5, 8*3*5} If the list were lista = {{2,4}, {3,2}, {5, 3},{7^5}}, we would have (4+1)(2+1)(3+1)(5+1) = 360 products, for example and the return values should be a single list showing all of those. Question 2. I have two lists and want to generate two new lists from them. These two lists are {number, exponent} pairs. In the first list, I want the minimum intersection of {number, exponent} pairs. In the second list, I want the maximum union of {number, exponent} pairs. Let me show an example: Input: list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}} list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}} Output: minint = {{2, 3}, {3, 2}, {5, 1}, {7, 2}} Note: In this example we only kept those pairs where the intersection of the number exists and also keep the min power of those. maxint = {{2, 5}, {3, 4}, {5, 6}, {7, 3}, {17, 5}} Note: In this example we kept the union of lists and also keep the max power of each. Flip ==== When using Parametric Plot to make closed Lissajous curves, it's best not to take the parameter too far. for instance the code ParametricPlot[{Sin[t], Sin[2t]}, {t, 0, 10Pi}] looks much the same if you go to 20Pi or 30 Pi. But if you go too far, say, 1000Pi, the curve will stray so much that it can appear, deceptively, to be an open Lissajous curve, filling the rectangle. I don't understand how it's doing this. I assume the reason has to do with machine precision, but can anyone tell me in a little detail what's happening here? thanks, -- _______________ Steve Story Polymer Research Group 411B Cox North Carolina State University 1-919-515-8147 _______________ ==== I'm attempting to identify the essential aspects of Mathematica. I believe the place to start is with the 'functional operations'. I'm seeking the 'basis' of Mathematica. Kind of the orthonormal subset of functionality which can be used to derive all the other. I'm also trying to be pragmatic. I'm not trying to reinvent Mathematica, I'm just trying to understand the invention that already exists. If anyone is interested in seeing what I've gathered so far, I have a notebook in both HTML, and Mathematica (4.2, if that matters) notebook format available here: http://public.globalsymmetry.com/proprietary/com/wri/notebooks/with-gif/esse ntial/essential.nb http://public.globalsymmetry.com/proprietary/com/wri/notebooks/with-gif/esse ntial/index.html Please let me know if you have any problems accessing these. The sysadmin is kind of new at running a DNS server. The server may go down for a while at Ideally that should take about an hour... and then there's reality... What I'm hoping for is some constructive feedback regarding my selection of functions. I am aware that I've neglected the more advanced use of these functions such as level specification. I'm trying to keep things as simple as possible. I'm not looking for the obfuscated Mathematica challenge. Not just yet. I'm seeking the examples which, if correctly understood, will make other Mathematica functionality fall into place. I believe there is also a set of 'procedural operators' which can properly be treated separately. I hope to get to them soon. I know I've received some very good feedback on other questions I've asked on the news group. I owe people responses to their thoughtful input. I hope to address these soon. I am very grateful to all who have responded to my questions. STH . ==== I would like to mark representative samples of t on a parametric plot, where t is the third parameter. For example, how could I mark the 8 values t=0, t=Pi/4, ..., t=7Pi/4 on the plot generated by: ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}] Reply-To: kuska@informatik.uni-leipzig.de ==== ff[t_] := {Sin[t], Cos[t]} ParametricPlot[Evaluate[ff[t]], {t, 0, 2Pi}, Epilog -> {PointSize[0.025], (Point[ff[#]] & /@ Table[phi, {phi, 0, 2Pi, Pi/4}])}] Jens > > I would like to mark representative samples of t on a parametric plot, > where t is the third parameter. For example, how could I mark the 8 > values t=0, t=Pi/4, ..., t=7Pi/4 on the plot generated by: > ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}] > ==== How do I evaluate this product in mathematica: f[s_]=Product[a+b*Exp[s*x[i]],{i,1,n}] ? D[f[s],s] does not evaluate the terms. ==== I want to perform this calculation: In[1]:=z1 = a1 + b1 I Out[1]=a1 + [ImaginaryI] b1 In[3]:=z2 = a2 + b2 I Out[3]=a2 + [ImaginaryI] b2 In[19]:=Abs[(z1 - z2)/(1 - z1 Conjugate[z2])] This should output 1! But it doesn't work... Also, Abs[a1+b1 I] doesn't get the right result. Any ideeas? CeZaR ==== Of course one can use standard programming techniques to answer this and it will in fact be the most efficient method. But as you will probably get lots of answers of this kind, I will do it in another way: by exploiting a few standard built-in number theoretic functions which are very closely connected with your problems. Question 1: In[1]:= funct1[l_List]:=Outer[Times,Sequence@@(Divisors/@Power@@@l)]//Flatten In[2]:= funct1[{{2,3},{3,1},{5,1}}] Out[2]= {1,5,3,15,2,10,6,30,4,20,12,60,8,40,24,120} Note what we did. We first converted your pairs {a,b} back into powers a^b then found all the divisors using the built in Divisors function, then found all the products using Outer. Question 2. In[3]:= minint[list1_,list2_]:=GCD[ Times@@Power@@@list1,Times@@Power@@@list2]//FactorInteger In[4]:= maxint[list1list1_,list2_]:=LCM[Times@@Power@@@list1,Times@@Power@@@list 2] //FactorInteger e.g. In[5]:= list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}}; In[6]:= list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}}; In[7]:= minint[list1,list2] Out[7]= {{2,3},{3,2},{5,1},{7,2}} In[8]:= maxint[list1,list2] Out[8]= {{2,5},{3,4},{5,6},{7,3},{17,5}} Basically all we did was to use the built in functions GCD and LCM after converting your lists of powers to numbers. Then we factored them again. In this case to finally factor an integer, which guarantees the programs to be inefficient for large numbers. However if your original list of pairs were indeed the result of using FactorInteger, then you should of course use versions of the above programs that can be applied to the original un-factored integers. Indeed, in that case this is the only efficient way to proceed. Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > > I have two seperate list questions that I was hoping to get help with. > > Question 1. > > I have a variable length list similar to that generated by > FactorInteger, > that is {number, exponent} pairs. An example follows. > > lista = {{2,3},{3,1},{5,1}} ... this is the number 2^3 * 3^1 * 5^1 > > I want to generate a list of all the products of numbers from this > list. > > I can tell that I get a total (3+1)*(1+1)*(1+1) = 4*2*2 = 16, products > and I > want a list showing all of those. > > These would be: > > 2^3 can generate {2^0, 2^1, 2^2, 2^3} = {1, 2, 4 ,8} > 3^1 can generate {3^0, 3^1} = {3} ... we dont care about the > duplicate 1 > 5^1 can generate {5^0, 5^1} = {5} ... we dont care about the duplicate > 1 > > Hence the 4*2*2 = 16 (the product of one more of the exponents) above. > > Next we should get 16 products (from these lists), namely (I left them > as > products below to show what I am after): > > {1, 2, 4, 8, 1*3, 2*3, 4*3, 8*3, 1*5, 2 * 5, 4* 5, 8* 5, 1*3*5, > 2*3*5, 4*3*5, 8*3*5} > > If the list were lista = {{2,4}, {3,2}, {5, 3},{7^5}}, we would have > (4+1)(2+1)(3+1)(5+1) = 360 products, for example and the return values > should be a single list showing all of those. > > Question 2. > > I have two lists and want to generate two new lists from them. These > two > lists are {number, exponent} pairs. > > In the first list, I want the minimum intersection of {number, > exponent} > pairs. > > In the second list, I want the maximum union of {number, exponent} > pairs. > > Let me show an example: > > Input: > > list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}} > > list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}} > > Output: > > minint = {{2, 3}, {3, 2}, {5, 1}, {7, 2}} > > Note: In this example we only kept those pairs where the intersection > of the > number exists and also keep the min power of those. > > maxint = {{2, 5}, {3, 4}, {5, 6}, {7, 3}, {17, 5}} > > Note: In this example we kept the union of lists and also keep the max > power > of each. > > > Flip > > > > > > > ==== To start with, what you are saying is simply not true. A simple example: In[1]:= Abs[(z1 - z2)/(1 - z1*Conjugate[z2])] /. {z1 -> 1 + I, z2 -> 1 - I} Out[1]= 2/Sqrt[5] Presumably you meant Abs[(z1 - z2)/(z1 - Conjugate[z2]) in which case: In[1]:= ComplexExpand[Abs[(z1-z2)/(z1- Conjugate[z2])],TargetFunctions->{Im,Re}] Out[1]= 1 Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > > I want to perform this calculation: > > In[1]:=z1 = a1 + b1 I > Out[1]=a1 + [ImaginaryI] b1 > In[3]:=z2 = a2 + b2 I > Out[3]=a2 + [ImaginaryI] b2 > In[19]:=Abs[(z1 - z2)/(1 - z1 Conjugate[z2])] > > This should output 1! But it doesn't work... > > Also, Abs[a1+b1 I] doesn't get the right result. > Any ideeas? > > CeZaR > > > ==== Charles, One method is to use Epilog as follows. For simplicity I define the parametrization of the curve, the list of t values and the list of associated points. It is also nice to add some color to the plot. Needs[Graphics`Colors`] curve[t_] := {Sin[t], Cos[t]} tvals = Pi/4Range[0, 7]; pts = curve /@ tvals; ParametricPlot[Evaluate[curve[t]], {t, 0, 2Pi}, PlotStyle -> Blue, Epilog -> {Black, AbsolutePointSize[5], Point /@ pts, MapThread[Text[#1, 1.1 #2] &, {tvals, pts}]}, Axes -> None, AspectRatio -> Automatic, PlotRange -> All, Background -> Linen, ImageSize -> 430]; If you use the DrawGraphics package at my web site, this can be done slightly easier, without using PlotStyle or Epilog. ParametricDraw just extracts the graphics primitives, actually the Line, from ParametricPlot without a side plot. Then we can just combine it with the Point and Text primitives. Draw2D is a shortcut for Show[Graphics[...],opts]; Needs[DrawGraphics`DrawingMaster`] Draw2D[ {Blue, ParametricDraw[Evaluate[curve[t]], {t, 0, 2Pi}], Black, AbsolutePointSize[5], Point /@ pts, MapThread[Text[#1, 1.1 #2] &, {tvals, pts}]}, AspectRatio -> Automatic, Background -> Linen, ImageSize -> 430]; David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Sender: steve@smc.vnet.net Approved: Steven M. Christensen , Moderator ==== I think a better place to look for the essential aspects of Mathematica are in rule application, pattern matching, and mathematical knowledge. I will be interested in hearing what other people have to say. Richard Palmer > I'm attempting to identify the essential aspects of Mathematica. I believe > the > place to start is with the 'functional operations'. I'm seeking the > 'basis' of Mathematica. Kind of the orthonormal subset of functionality > which can be used to derive all the other. I'm also trying to be > pragmatic. I'm not trying to reinvent Mathematica, I'm just trying to > understand > the invention that already exists. > > If anyone is interested in seeing what I've gathered so far, I have a > notebook in both HTML, and Mathematica (4.2, if that matters) notebook format > available here: > > http://public.globalsymmetry.com/proprietary/com/wri/notebooks/with-gif/essen t > ial/essential.nb > http://public.globalsymmetry.com/proprietary/com/wri/notebooks/with-gif/essen t > ial/index.html > > Please let me know if you have any problems accessing these. The sysadmin is > kind of new at running a DNS server. The server may go down for a while at > Ideally that should take about an hour... and then there's reality... > > What I'm hoping for is some constructive feedback regarding my selection of > functions. I am aware that I've neglected the more advanced use of these > functions such as level specification. I'm trying to keep things as simple > as possible. I'm not looking for the obfuscated Mathematica challenge. Not > just > yet. I'm seeking the examples which, if correctly understood, will make > other Mathematica functionality fall into place. I believe there is also a > set of > 'procedural operators' which can properly be treated separately. I hope to > get to them soon. > > I know I've received some very good feedback on other questions I've asked > on the news group. I owe people responses to their thoughtful input. I > hope to address these soon. I am very grateful to all who have responded > to my questions. > > STH ==== >I have build a table with this pattern: > >Flatten[{{{d, X, Y, Z}}, > Table[{t, x[t], y[t], z[t]}, {t, 1, 10}], > Table[{t, x[t], y[t], z[t]}, {t, 20, 100, 10}], > Table[{t, x[t], y[t], z[t]}, {t, 200, 1000, 100}]}, 1] // TableForm > >I would like obtain the same Output in a more elegant way. In other word, >how >Can I avoid write Table[{t, x[t], y[t], z[t]} a few times. > Fit[{1, 20, 200}, {1, n, n^2}, n] Flatten[ Prepend[ Table[{t, x[t], y[t], z[t]}, {n, 3}, {t, (161*n^2)/2 - (445*n)/2 + 143, 10^n, 10^(n - 1)}], {{d, X, Y, Z}}], 1] Bob Hanlon ==== >I would like to mark representative samples of t on a parametric plot, >where t is the third parameter. For example, how could I mark the 8 >values t=0, t=Pi/4, ..., t=7Pi/4 on the plot generated by: >ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}] > ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}, AspectRatio -> Automatic, Epilog -> {AbsolutePointSize[5], RGBColor[1, 0, 0], Table[Point[{Sin[t], Cos[t]}], {t, 0, 7Pi/4, Pi/4}]}]; Bob Hanlon ==== > I would like to mark representative samples of t on a parametric plot, > where t is the third parameter. For example, how could I mark the 8 > values t=0, t=Pi/4, ..., t=7Pi/4 on the plot generated by: > ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}] One way is to use Epilog: ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2*Pi}, Epilog -> {PointSize[0.02], Table[With[{p = {Sin[t], Cos[t]}}, {Point[p],Text[t, p, -1.5*p]}], {t, Pi/4, 7*(Pi/4), Pi/4}]}, PlotRange -> All] ==== >I would like to mark representative samples of t on a parametric plot, >where t is the third parameter. For example, how could I mark the 8 >values t=0, t=Pi/4, ..., t=7Pi/4 on the plot generated by: >ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}] There are a number of possibilities depending on exactly how you want things to appear You could use Ticks->{Cos[# Pi/4]&/@Range[0,7],Sin[# Pi/4]&/@Range[0,7]} combined with Axes->True and seting AxesOrigin to an appropriate location Another option would be using Epilog->MapThread[Point[{#1,#2}]&,Cos[# Pi/4]&/@Range[0,7],Sin[# Pi/4]&/@Range[0,7]}] to plot points at the key locations. In order to get a satisfactory display you may also need to adjust either PointSize or PlotStyle. Other options include making plots of the marks and the parametric plot as separate graphics then combining them with the Show command ==== >I have two seperate list questions that I was hoping to get help with. > >Question 1. > > I have a variable length list similar to that generated by FactorInteger, >that is {number, exponent} pairs. An example follows. > >lista = {{2,3},{3,1},{5,1}} ... this is the number 2^3 * 3^1 * 5^1 > >I want to generate a list of all the products of numbers from this list. > >I can tell that I get a total (3+1)*(1+1)*(1+1) = 4*2*2 = 16, products >and I >want a list showing all of those. > >These would be: > >2^3 can generate {2^0, 2^1, 2^2, 2^3} = {1, 2, 4 ,8} >3^1 can generate {3^0, 3^1} = {3} ... we dont care about the duplicate >1 >5^1 can generate {5^0, 5^1} = {5} ... we dont care about the duplicate >1 > >Hence the 4*2*2 = 16 (the product of one more of the exponents) above. > >Next we should get 16 products (from these lists), namely (I left them >as >products below to show what I am after): > >{1, 2, 4, 8, 1*3, 2*3, 4*3, 8*3, 1*5, 2 * 5, 4* 5, 8* 5, 1*3*5, >2*3*5, 4*3*5, 8*3*5} > >If the list were lista = {{2,4}, {3,2}, {5, 3},{7^5}}, we would have >(4+1)(2+1)(3+1)(5+1) = 360 products, for example and the return values >should be a single list showing all of those. > >Question 2. > >I have two lists and want to generate two new lists from them. These two >lists are {number, exponent} pairs. > >In the first list, I want the minimum intersection of {number, exponent} >pairs. > >In the second list, I want the maximum union of {number, exponent} pairs. > >Let me show an example: > >Input: > >list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}} > >list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}} > >Output: > >minint = {{2, 3}, {3, 2}, {5, 1}, {7, 2}} > >Note: In this example we only kept those pairs where the intersection of >the >number exists and also keep the min power of those. > >maxint = {{2, 5}, {3, 4}, {5, 6}, {7, 3}, {17, 5}} > >Note: In this example we kept the union of lists and also keep the max >power >of each. > allProducts[x_] := Module[{sx = Sort[x, #2[[2]] < #1[[2]] &], f}, Union[Flatten[ Outer[f, Sequence @@ (PadRight[#, sx[[1, -1]] + 1, 1] & /@ (#[[1]]^ Range[0, #[[2]]] & /@ sx))]] /. f -> Times]]; lista = {{2, 3}, {3, 1}, {5, 1}}; allProducts[lista] {1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 20, 24, 30, 40, 60, 120} minInt[x_, y_] := FactorInteger[GCD[ Times @@ (#[[1]]^#[[2]] & /@ x), Times @@ (#[[1]]^#[[2]] & /@ y)]]; maxInt[x_, y_] := Union[x, y] //. {s___, {b_, e1_}, {b_, e2_}, r___} :> {s, {b, Max[e1, e2]}, r} list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}}; list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}}; minInt[list1, list2] {{2, 3}, {3, 2}, {5, 1}, {7, 2}} maxInt[list1, list2] {{2, 5}, {3, 4}, {5, 6}, {7, 3}, {17, 5}} Bob Hanlon ==== >I want to perform this calculation: > >In[1]:=z1 = a1 + b1 I Out[1]=a1 + [ImaginaryI] b1 In[3]:=z2 = a2 + b2 >I Out[3]=a2 + [ImaginaryI] b2 In[19]:=Abs[(z1 - z2)/(1 - z1 >Conjugate[z2])] > >This should output 1! But it doesn't work... > >Also, Abs[a1+b1 I] doesn't get the right result. Any ideeas? What do you mean by doesn't work and doesn't get the right result? Do you mean Mathematica returns an unevaluated expression? If so, have you assigned values to the symbols a1, b1, a2 and b2? If you haven't assigned values, how is Mathematica to know these symbols do not take on complex values? ==== > >I want to perform this calculation: > >In[1]:=z1 = a1 + b1 I Out[1]=a1 + [ImaginaryI] b1 In[3]:=z2 = a2 + b2 >I Out[3]=a2 + [ImaginaryI] b2 In[19]:=Abs[(z1 - z2)/(1 - z1 >Conjugate[z2])] > >This should output 1! But it doesn't work... > >Also, Abs[a1+b1 I] doesn't get the right result. Any ideeas? > > What do you mean by doesn't work and doesn't get the right result? Do you mean Mathematica returns an unevaluated expression? If so, have you assigned values to the symbols a1, b1, a2 and b2? If you haven't assigned values, how is Mathematica to know these symbols do not take on complex values? Yes, it returns an unevaluated expression. CeZaR ==== Steve, Increase the PlotPoints. ParametricPlot[{Sin[t], Sin[2t]}, {t, 0, 1000Pi}, PlotPoints -> 2000]; But, generally one wouldn't want to make the t domain greater than required to plot the complete figure, in this case 0 to 2 Pi. David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ -- _______________ Steve Story Polymer Research Group 411B Cox North Carolina State University 1-919-515-8147 _______________ ==== Guillermo, This might be considered slightly better.. TableForm[{#, x[#], y[#], z[#]} & /@ Join[Range[10], Range[20, 100, 10], Range[200, 1000, 100]], TableHeadings -> {None, {d, X, Y, Z}}] David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Thans Guillermo Sanchez --------------------------------------------- This message was sent using Endymion MailMan. ==== Luca, It looks like Mathematica doesn't implement the Leibniz rule on indefinite products. Here is my attempt to implement it. I hope I haven't slipped up. You may get some other better answers. I am not going to paste in all the output because you can duplicate it in your own notebook. First I define your f, separating the parameters from the variable s. f[a_, b_, n_][s_] := Product[a + b*Exp[s*x[i]], {i, 1, n}] You could differentiate with respect to s by f[a,b,n]'[s] but Mathematica doesn't evaluate. However, if you specify an integer for n, Mathematica will evaluate. f[a,b,3]'[s] LeibnizD::usage = LeibnizD[product, x] will differentiate an indefinite product expression with respect to x using the Leibniz rule. The product must be of the form Product[factor, {iter, min, max}].; LeibnizD[p_Product, x_] := Module[{factor, term, piter, pmin, pmax}, {piter, pmin, pmax} = Rest[p]; factor = First[p]; term = (D[factor, x])/factor ; p Sum[term // Evaluate, {piter, pmin, pmax} // Evaluate]] Then the following gives the differentiation in terms of the original product times a sum. LeibnizD[f[a, b, n][s], s] Checking one case.. f[a, b, 3]'[s] == (LeibnizD[f[a, b, n][s], s] /. n -> 3) // Simplify True And if it correct for one case it must be correct for all. Right? David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Sender: steve@smc.vnet.net Approved: Steven M. Christensen , Moderator ==== I noticed a rather curious trick that can be used to avoid having to use FactorInteger in the code I sent earlier for minint and maxint. Here is the new version: In[2]:= list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}}; In[3]:= list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}}; In[4]:= minint[list1_List, list2_List] := ToExpression[PolynomialGCD[Times @@ Apply[ToString[#1]^#2 & , list1, {1}], Times @@ Apply[ToString[#1]^#2 & , list2, {1}]] /. {Times -> List, Power -> List}] In[5]:= maxint[list1_List, list2_List] := ToExpression[PolynomialLCM[Times @@ Apply[ToString[#1]^#2 & , list1, {1}], Times @@ Apply[ToString[#1]^#2 & , list2, {1}]] /. {Times -> List, Power -> List}] In[6]:= minint[list1, list2] Out[6]= {{2, 3}, {3, 2}, 5, {7, 2}} In[7]:= maxint[list1, list2] Out[7]= {{17, 5}, {2, 5}, {3, 4}, {5, 6}, {7, 3}} The idea is to do exactly the same thing as before but now we find the GCD and LCM of expressions like 2^3 *5^4 and 2^4*5^3 etc. Note that the base in a^b is a string and not a number so we need to use PolynomialGCD and PoynomialLCM instead of GCD and LCM. Using such algebraic functions will usually make the program slower, but on the other hand we need not use FactorInteger so when the numbers one gets are large enough the present version should be faster. In any case it seems a curious idea so I thought it worth posting (even though it is easy to write conventional programs to do the same thing that ought to be much more efficient). > Of course one can use standard programming techniques to answer this > and it will in fact be the most efficient method. But as you will > probably get lots of answers of this kind, I will do it in another > way: by exploiting a few standard built-in number theoretic functions > which are very closely connected with your problems. > > Question 1: > > In[1]:= > funct1[l_List]:=Outer[Times,Sequence@@(Divisors/@Power@@@l)]//Flatten > > In[2]:= > funct1[{{2,3},{3,1},{5,1}}] > > Out[2]= > {1,5,3,15,2,10,6,30,4,20,12,60,8,40,24,120} > > Note what we did. We first converted your pairs {a,b} back into > powers a^b then found all the divisors using the built in Divisors > function, then found all the products using Outer. > > Question 2. > > In[3]:= > minint[list1_,list2_]:=GCD[ > Times@@Power@@@list1,Times@@Power@@@list2]//FactorInteger > > In[4]:= > maxint[list1list1_,list2_]:=LCM[Times@@Power@@@list1,Times@@Power@@@lis > t2] > //FactorInteger > > e.g. > > In[5]:= > list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}}; > > > In[6]:= > list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}}; > > > In[7]:= > minint[list1,list2] > > Out[7]= > {{2,3},{3,2},{5,1},{7,2}} > > In[8]:= > maxint[list1,list2] > > Out[8]= > {{2,5},{3,4},{5,6},{7,3},{17,5}} > > Basically all we did was to use the built in functions GCD and LCM > after converting your lists of powers to numbers. Then we factored > them again. > > In this case to finally factor an integer, which guarantees the > programs to be inefficient for large numbers. However if your original > list of pairs were indeed the result of using FactorInteger, then you > should of course use versions of the above programs that can be > applied to the original un-factored integers. Indeed, in that case > this is the only efficient way to proceed. > > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ > > > >> >> I have two seperate list questions that I was hoping to get help with. >> >> Question 1. >> >> I have a variable length list similar to that generated by >> FactorInteger, >> that is {number, exponent} pairs. An example follows. >> >> lista = {{2,3},{3,1},{5,1}} ... this is the number 2^3 * 3^1 * 5^1 >> >> I want to generate a list of all the products of numbers from this >> list. >> >> I can tell that I get a total (3+1)*(1+1)*(1+1) = 4*2*2 = 16, >> products and I >> want a list showing all of those. >> >> These would be: >> >> 2^3 can generate {2^0, 2^1, 2^2, 2^3} = {1, 2, 4 ,8} >> 3^1 can generate {3^0, 3^1} = {3} ... we dont care about the >> duplicate 1 >> 5^1 can generate {5^0, 5^1} = {5} ... we dont care about the >> duplicate 1 >> >> Hence the 4*2*2 = 16 (the product of one more of the exponents) above. >> >> Next we should get 16 products (from these lists), namely (I left >> them as >> products below to show what I am after): >> >> {1, 2, 4, 8, 1*3, 2*3, 4*3, 8*3, 1*5, 2 * 5, 4* 5, 8* 5, 1*3*5, >> 2*3*5, 4*3*5, 8*3*5} >> >> If the list were lista = {{2,4}, {3,2}, {5, 3},{7^5}}, we would have >> (4+1)(2+1)(3+1)(5+1) = 360 products, for example and the return values >> should be a single list showing all of those. >> >> Question 2. >> >> I have two lists and want to generate two new lists from them. These >> two >> lists are {number, exponent} pairs. >> >> In the first list, I want the minimum intersection of {number, >> exponent} >> pairs. >> >> In the second list, I want the maximum union of {number, exponent} >> pairs. >> >> Let me show an example: >> >> Input: >> >> list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}} >> >> list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}} >> >> Output: >> >> minint = {{2, 3}, {3, 2}, {5, 1}, {7, 2}} >> >> Note: In this example we only kept those pairs where the intersection >> of the >> number exists and also keep the min power of those. >> >> maxint = {{2, 5}, {3, 4}, {5, 6}, {7, 3}, {17, 5}} >> >> Note: In this example we kept the union of lists and also keep the >> max power >> of each. >> >> >> Flip >> >> >> >> >> >> >> > > > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ > > Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ ==== If you use SetDelayed rather than Set, and then Simplify, Mathematica returns the answer you expect: f[t_] := {t + Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]} ; Simplify[Sqrt[f'[t] .f'[t]]] Out[2]= 2 Sqrt[2] >Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]} So It's basically a vector >whose coordinates are determined based on the values you pass in. Then I >took the derivative by just typing f', which outputs {1 + Sqrt[3] Cos[#1], >-2 Sin[#1], Sqrt[3] - Cos[#1]}& What I'd like to do is have Mathematica >calculate the norm of this as it would any vector, so that I can play with >the norm function. As it turns out, the norm in this case is identical to >Sqrt[8], so it would be nice if Mathematica could figure that out. Is it Christopher J. Purcell Defence R&D Canada ö Atlantic 9 Grove St., PO Box 1012 Dartmouth NS Canada B2Y 3Z7 ==== >I wanted to do list manipulation methods explicitly on the lists without >using GCD and FactoInteger specifically. I am doing things with numbers >that I know the factorization for, but the methods in Mathematica (or anything >else for that matter) don't suffice. > >Is there an easy way to get rid of the GCD and FactorInteger in the second >method. > minInt[x_, y_] := Select[Union[x, y], MemberQ[First /@ Intersection[x, y, SameTest -> (#1[[1]] == #2[[1]] &)], #[[1]]] &] //. {s___, {b_, e1_}, {b_, e2_}, r___} :> {s, {b, Min[e1, e2]}, r}; list1 = {{2, 3}, {3, 4}, {5, 6}, {7, 2}, {17, 5}}; list2 = {{2, 5}, {3, 2}, {5, 1}, {7, 3}}; minInt[list1, list2] {{2, 3}, {3, 2}, {5, 1}, {7, 2}} Bob Hanlon ==== I'm using mozilla I built a few hours ago. The classical mechanics site look very nice. I did, however receive the errors described here: http://baldur.globalsymmetry.com/proprietary/com/wri/ch08.html To properly display the MathML on this page you need the following fonts: CMSY10, CMEX10, Math1, Math2, Math4. For further infromation see: http://www.mozilla.org/projects/mathml/fonts Among the fonts which I seem to be missin is the one used to display the imaginary coeficient in the MathML discussed below. You will find more discussion of my experiences with XML and Mathematica on the page I linked to above. I believe there is something which still needs to be done with my fonts, but I haven't had time to research it. If anyone knows the solution, I would really appreciate knowing. I can think of installed. The display is a bit better on the XP system, but for the most part, the results are similar. STH > Steven > I have done a great deal with MathML and esp with Mathematica 4.2 > a) you need a modern browser NS 7.0 or Mozilla 1 or Amaya > b) IE needs a plugin www.dessci.com has mathplayer but there are other > issues > c) The rendering is done by the browser as is the XML parsing > d) an on line example is at > > http://core.ecu.edu/phys/flurchickk/Classes/CM4226/classicalMechanics2-1.xm >l e) you can test the browser with the w3c test site > http://www.w3.org/Math/testsuite/ > -----Original Message----- > Sent: Saturday, October 12, 2002 5:05 AM > To: mathgroup@smc.vnet.net > > > I'm trying to get a handle on Mathematica's XML capabilities. I'm finding > a few > things to be a bit confusing. One of these is where the > http://www.wolfram.com/XML/DTD/2001/NBMLwMathML.dtd really is. Another > point of confusion is how exactly the rendering in the browser is expected > to take place. If needs be, I can spin up my own CSS. Does Mathematica > provide > CSS for MathML or NBML? I've character mentioned entity references before, > but I still haven't found an answer. What I've found here seems > inconsistent with what Mathematica chose for the character entity reference > for an > imaginary number: http://www.bitjungle.com/~isoent/ > > This is what Mathematica produced for a complex number: > >

> > > cpx > > > = > > > 1066 > > + > > > > 42 > ⁢ > ⅈ > > > > > ; > >

> > If I understand the http://www.bitjungle.com/~isoent/ent.xml, the imaginary > number symbol should be ࠿ which is a black letter capital 'I'. That > doesn't seem correct to me. I'm currently stumbling around in here looking > for a possible clue as to what I should expect: > http://www.physiome.org.nz/Docs/web-tech/specs/mathML20/chapter3.html > > Has anybody worked with this? > > STH ==== I'm trying to get a handle on Mathematica's XML capabilities. I'm finding a few things to be a bit confusing. One of these is where the http://www.wolfram.com/XML/DTD/2001/NBMLwMathML.dtd really is. Another point of confusion is how exactly the rendering in the browser is expected to take place. If needs be, I can spin up my own CSS. Does Mathematica provide CSS for MathML or NBML? I've character mentioned entity references before, but I still haven't found an answer. What I've found here seems inconsistent with what Mathematica chose for the character entity reference for an imaginary number: http://www.bitjungle.com/~isoent/ This is what Mathematica produced for a complex number:

cpx = 1066 + 42 ⁢ ⅈ ;

If I understand the http://www.bitjungle.com/~isoent/ent.xml, the imaginary number symbol should be ࠿ which is a black letter capital 'I'. That doesn't seem correct to me. I'm currently stumbling around in here looking for a possible clue as to what I should expect: http://www.physiome.org.nz/Docs/web-tech/specs/mathML20/chapter3.html Has anybody worked with this? STH . Reply-To: Lester Ingber ==== If you have very strong credentials for the position described below, Lester Ingber Director R&D DUNN Capital Management Stuart FL Some recent press on DUNN can be seen on http://www.businessweek.com/magazine/content/02_39/b3801113.htm http://www.businessweek.com/magazine/content/02_39/b3801114.htm Financial Engineer A disciplined, quantitative, analytic individual proficient in prototyping and coding (such as C/C++, Maple/Mathematica, or Visual Basic, etc.) is sought for financial engineering/risk:reward optimization research position with established Florida hedge fund (over two decades in the business and $1 billion in assets under management). A PhD in a mathematical science, such as physics, statistics, math, or computer-science, is preferred. Hands-on experience in the financial industry is required. Emphasis is on applying state-of-the-art methods to financial time-series of various frequencies. Ability to work with a team to transform ideas/models into robust, intelligible code is key. Salary: commensurate with experience, with bonuses tied to the individual's and the firm's performance. Status of Selection Process All applicants will be reviewed, and a long list will be generated for phone interviews. Other applicants will not be contacted further. Information on the status of this process will be available in http://www.ingber.com/open_positions.html face-to-face interviews. During the visit for the physical interview a small coding exam will be given. Start date for this position may range anywhere from immediately to six months thereafter, depending on both the candidate's and the firm's needs. -- Prof. Lester Ingber ingber@ingber.com ingber@alumni.caltech.edu www.ingber.com www.alumni.caltech.edu/~ingber ==== Sorry, my message was nonsense. The reason why it appeared to give the answer 1 is that I forgot to evaluate z1 an z2: In[7]:= z1 = a1 + b1*I; In[8]:= z2 = a2 + b2*I; In[9]:= ComplexExpand[Abs[(z1 - z2)/(z1 - Conjugate[z2])], TargetFunctions -> {Im, Re}] Out[9]= Sqrt[(a1 - a2)^2 + (b1 - b2)^2]/ Sqrt[(a1 - a2)^2 + (b1 + b2)^2] The answer is clearly not unless b2==0. What exactly did you have in mind? > To start with, what you are saying is simply not true. A simple > example: > > In[1]:= > Abs[(z1 - z2)/(1 - z1*Conjugate[z2])] /. > {z1 -> 1 + I, z2 -> 1 - I} > > Out[1]= > 2/Sqrt[5] > > Presumably you meant Abs[(z1 - z2)/(z1 - Conjugate[z2]) in which case: > > In[1]:= > ComplexExpand[Abs[(z1-z2)/(z1- > Conjugate[z2])],TargetFunctions->{Im,Re}] > > Out[1]= > 1 > > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ > > > >> >> I want to perform this calculation: >> >> In[1]:=z1 = a1 + b1 I >> Out[1]=a1 + [ImaginaryI] b1 >> In[3]:=z2 = a2 + b2 I >> Out[3]=a2 + [ImaginaryI] b2 >> In[19]:=Abs[(z1 - z2)/(1 - z1 Conjugate[z2])] >> >> This should output 1! But it doesn't work... >> >> Also, Abs[a1+b1 I] doesn't get the right result. >> Any ideeas? >> >> CeZaR >> >> >> > > > > Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ ==== Dear Listers, I find myself defining functions in terms of differentiation. For example, f[x_,t_]:=Sin[x*t] dfx[x_,t]:=D[Sin[y,t],y]/.y->x This works well, but it seems to me that there should be a better way to do this. That is, there should be a better way to define a 'derivative' of a previous function without going through the replacement contortions. I can't find the answer in the archive. Can someone tell me the most straightforward way to do this? Will it work to define a gradient vector or Jacobian matrix? A Hessian matrix? -- Jason Miller, Ph.D. Division of Mathematics and Computer Science Truman State University 100 East Normal St. Kirksville, MO 63501 http://vh216801.truman.edu 660.785.7430 ==== Jason, We have dfx[x_,t_]= D[f[x,t],x] t Cos[t x] One advantage of using = rather than := is that it differentiates once, when the definition is stored, Definition[dfx] t Cos[t x] With := we get Clear[dfx] dfx[x_,t_]:= D[f[x,t],x] Definition[dfx] dfx[x_, t_] := D[f[x, t], x] So the differentiation is done each time that the function dfx is evaluated. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Dear Listers, > > I find myself defining functions in terms of differentiation. For example, > > f[x_,t_]:=Sin[x*t] > dfx[x_,t]:=D[Sin[y,t],y]/.y->x > > This works well, but it seems to me that there should be a better way > to do this. That is, there should be a better way to define a > 'derivative' of a previous function without going through the > replacement contortions. I can't find the answer in the archive. > Can someone tell me the most straightforward way to do this? Will it > work to define a gradient vector or Jacobian matrix? A Hessian > matrix? > > -- > Jason Miller, Ph.D. > Division of Mathematics and Computer Science > Truman State University > 100 East Normal St. > Kirksville, MO 63501 > http://vh216801.truman.edu > 660.785.7430 > Reply-To: kuska@informatik.uni-leipzig.de ==== f[x_, t_] := Sin[x*t] dfx[x_, t_] := Module[{y, df}, df = D[f[y, t], y]; Block[{y = x}, df ] ] Jens > > Dear Listers, > > I find myself defining functions in terms of differentiation. For example, > > f[x_,t_]:=Sin[x*t] > dfx[x_,t]:=D[Sin[y,t],y]/.y->x > > This works well, but it seems to me that there should be a better way > to do this. That is, there should be a better way to define a > 'derivative' of a previous function without going through the > replacement contortions. I can't find the answer in the archive. > Can someone tell me the most straightforward way to do this? Will it > work to define a gradient vector or Jacobian matrix? A Hessian > matrix? > > -- > Jason Miller, Ph.D. > Division of Mathematics and Computer Science > Truman State University > 100 East Normal St. > Kirksville, MO 63501 > http://vh216801.truman.edu > 660.785.7430 ==== I was trying to write a function, when given a list, say, {a,b,c,d}, the output is a op b op c op d, where op is (in LaTeX) bigotimes, or esc c * esc ([CircleTimes]) in Mathematica. f[{x_}]:=x; f[{x_, y_, z___}]:=f[Join[{x[CircleTimes]y},{z}]]; However, the output was not exactly what I expected, it looked like: ((a op b) op c) op d It seems when doing the Join operation, a pair of parenthesis was added. Can someone let me know how I can get rid of these parenthesis? JT _________________________________________________________________ Chat with friends online, try MSN Messenger: http://messenger.msn.com ==== > I was trying to write a function, when given a list, say, {a,b,c,d}, the > output is a op b op c op d, where op is (in LaTeX) bigotimes, or esc c * > esc ([CircleTimes]) in Mathematica. > > f[{x_}]:=x; > f[{x_, y_, z___}]:=f[Join[{x[CircleTimes]y},{z}]]; > > However, the output was not exactly what I expected, it looked like: > > ((a op b) op c) op d > > It seems when doing the Join operation, a pair of parenthesis was added. > > Can someone let me know how I can get rid of these parenthesis? > > > JT > > > _________________________________________________________________ > Chat with friends online, try MSN Messenger: http://messenger.msn.com > > You can be very effective with a simple trick f[MyList_]:=Drop[Flatten[Transpose[{MyList,Table[op,Length[MyList]]}]],-1 ] then you can apply on it a conversion to string then save it to a file to be processed by TeX/LateX ==== JJJ, Try: f[{x_}]:=x; f[{x_,y__}]:=x[CircleTimes]y Test f[{a,b,c,d}] a[CircleTimes]b[CircleTimes]c[CircleTimes]d -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > I was trying to write a function, when given a list, say, {a,b,c,d}, the > output is a op b op c op d, where op is (in LaTeX) bigotimes, or esc c * > esc ([CircleTimes]) in Mathematica. > > f[{x_}]:=x; > f[{x_, y_, z___}]:=f[Join[{x[CircleTimes]y},{z}]]; > > However, the output was not exactly what I expected, it looked like: > > ((a op b) op c) op d > > It seems when doing the Join operation, a pair of parenthesis was added. > > Can someone let me know how I can get rid of these parenthesis? > > > JT > > > _________________________________________________________________ > Chat with friends online, try MSN Messenger: http://messenger.msn.com > > Reply-To: kuska@informatik.uni-leipzig.de ==== SetAttributes[CircleTimes, Flat] f[{x_}] := x; f[{x_, y_, z___}] := f[Join[{x[CircleTimes]y}, {z}]]; Jens > > I was trying to write a function, when given a list, say, {a,b,c,d}, the > output is a op b op c op d, where op is (in LaTeX) bigotimes, or esc c * > esc ([CircleTimes]) in Mathematica. > > f[{x_}]:=x; > f[{x_, y_, z___}]:=f[Join[{x[CircleTimes]y},{z}]]; > > However, the output was not exactly what I expected, it looked like: > > ((a op b) op c) op d > > It seems when doing the Join operation, a pair of parenthesis was added. > > Can someone let me know how I can get rid of these parenthesis? > > > JT > > _________________________________________________________________ > Chat with friends online, try MSN Messenger: http://messenger.msn.com ==== the least of which was a power failure. For some strange reason Mathematica stopped producing the pretty html+MathML it had been. I started trouble shooting, and blew away what I had pointed to. I violated Tom Jackson's (IBM & UMUC) first rule of holes: when you're in one, stop digging. Here's the parent directory. http://public.globalsymmetry.com/proprietary/com/wri/notebooks/ As you can see (If I haven't fixed it by the time you look again,) Mathematica is outputting the conversion command, rather than the actual MathML I really don't know what happened. I removed the init.m and deleted the cache, and it still refuses to work correctly. It's kind of frustrating. There are a lot of powerful XML features in Mathematica, but they are not easy to use. STH > cannot access... > thanks, > Steven Taracevicz > PO Box 1752 > Santa Monica, CA 90406-1752 > > 310.396.4001 > 310.388.3265 fax ==== > I'm attempting to identify the essential aspects of Mathematica. I believe > the > place to start is with the 'functional operations'. I'm seeking the > 'basis' of Mathematica. Kind of the orthonormal subset of functionality > which can be used to derive all the other. I'm also trying to be > pragmatic. I'm not trying to reinvent Mathematica, I'm just trying to > understand > the invention that already exists... I apologize in advance for this pessimistic response, but here goes: I have attempted something similar on two occasions, but with very specific audiences in mind. Even so, my efforts were little better than useless. (I would be willing to send you my most recent attempt, but as I said, it didn't work well.) I doubt that you can find agreement among the sea of users of Mathematica as to what is essential or basic or an orthonormal subset. The kernel is well described in the Mathematica book (for those of us who are careful readers or are refreshing memories) and in other books (for the rest of us). Would it not be a better use of your time to refer to selected passages in existing books? Documentation of the front end is uneven, with vast uncharted areas (I'm not even sure when it's round or flat!). Original writing about the front end might be more fruitful. Tom Burton ==== The way I learned XML, XML is for content, and CSS is for display. It seems that MathML violates that separation between style and content. There is little chance that I'm the first one to mention this. Is there a history of discussion on this topic somewhere? I don't want to get too far into MathML on this list, but, since I'm skinning my knuckles trying to learn to work with MathML and Mathematica, I figure a bit of discussion on this topic in this context is in order. STH ==== > > How can I plot functions like: > > (x-2)^2 + 2(y-3)^2 = 6 > > and > > x^3y + y^3 = 9 > > using Mathematica? David, x /. Solve[x^3 y + y^3 == 9, x]; g=Plot[Sign[(9 - y^3)/y]* Abs[(9 - y^3)/y]^(1/3) , {y, -7, 7} , AspectRatio -> Automatic]; Show[g /. {x_?NumberQ, y_?NumberQ} -> {y, x}, Epilog -> {RGBColor[1,0,0],Line[{{-(3^(7/9)/2^(2/9)), -5}, {-(3^(7/9)/2^(2/9)), 5}}]}]; ==== Is there an SGML catalog for the WRI DTDs on the CD? I'm not sure if I should expect psgml with xemacs to handle namespaces correctly. Currently, I'm having problems using the xml generated by Mathematica with psgml. I'm not sure exactly how to set up an sgml catalog to support these. I really don't want to try to reinvent the wheel, if there is already one available. I'm thouroughly preplexed by the overall behavior of the XML support. Things which were working have now stopped working, or have significantly changed their behavior. This is a very exciting area, but it seems very difficult to get started. I believe the dtd to include in a catalog is this: /opt/Wolfram/Mathematica/4.2/SystemFiles/IncludeFiles/XML/xhtml-math11-f.dtd I'm just not sure what the public identifier should be. STH -- Hatton's Law: There is only One inviolable Law. ==== Yes, there seems to be a lot of people who have a visceral hatred for Microsoft and Windows. They are even willing to shed blood to avoid Windows. But why? Windows works and you don't have to become a systems programmer. Furthermore, I think that Steven Wolfram uses some version of Windows. So guess which system Mathematica will be best tuned up for? I have no problems with Mathematica and Windows on my single computer. There may be reasons for using a non-Microsoft operating system. But if you are going to do it, make certain that they are good reasons. David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ ==== > Yes, there seems to be a lot of people who have a visceral hatred for > Microsoft and Windows. They are even willing to shed blood to avoid > Windows. But why? Windows works and you don't have to become a systems > programmer. > > Furthermore, I think that Steven Wolfram uses some version of Windows. So > guess which system Mathematica will be best tuned up for? > > I have no problems with Mathematica and Windows on my single computer. > There may be reasons for using a non-Microsoft operating system. But if > you are going to do it, make certain that they are good reasons. that of Windows XP by orders of magnitude. I recall when I first started been using Windows NT since October of 1992. (Yes, I know it hadn't been paper on the architecture of NT. In 1997 I was well on my way to being an MCSE. no stinkin' GUI' to 'have a look at the KDE project'. I took the latter route. The KDE has gone from a simple graphical desktop with a few more features than the CDE, (and a lot more glitches) to being the best desktop available. It's growth seems to be exponential. Windows seems, at best, to be linear. All of these are usability issues. There is another reason I don't like using Microsoft products. I've also been using Mozilla since 1995. (Yes, it has always been called Mozilla.) I was one of the original beta testers for the Netscape line of internet servers. When I saw what Netscape Communications were aiming for, Windows quickly lost its luster. Netscape products were designed from the ground up with portability in mind. They were striving for uniform functionality across all platforms. I also saw what Microsoft did to undermine Netscape's R & D resources. Microsoft would condescend to having not competition in their market. Where I come from, people don't put up with that. Where do I come from? I was born in Illinois. I'm obviously not of the opinion that closed source is unacceptable. I wouldn't be using Mathematica if I were. I suspect one day Mathematica will face a real open source challeng. Her name is Charolette. She is the mother of Mozilla. That will probably be years from now. WRI need to be prepared to adjust to that eventuality when it comes. > David Park > djmp@earthlink.net > http://home.earthlink.net/~djmp/ STH . ==== >In: DSolve[y*D[u[x, y],x] == x*D[u[x, y],y], u[x,y], {x, y}] > >Out: {{u[x, y] -> C[1][(1/2)*(x^2 + y^2)]}} > >Square brackets are used as grouping symbols in the result!?? :^O > >Somebody say it isn't so. > It isn't so The square bracket is not delineating a factor it is enclosing the argument to an arbitrary function named C[1]. While the function is dependent on both x and y the dependence only occurs in the combination (x^2+y^2). Bob Hanlon Reply-To: Mark Coleman ==== Greetings, I hope this inquiry is not off-topic for the list. I was wondering if anyone knew of Mathematica-based education resources (either for students or teachers) that would be suitable for teaching *elementary school* students (kindergartden - 5th grade) some basic fundamentals of mathematics, e.g., simple algebra, geometry, numbers,etc. I know there is a solid body of work directed towards high school and college students, but I am not sure of resources for younger students. Mark ==== > f[{x_}]:=x; > f[{x_, y_, z___}]:=f[Join[{x[CircleTimes]y},{z}]]; > > However, the output was not exactly what I expected, it looked like: > > ((a op b) op c) op d > > It seems when doing the Join operation, a pair of parenthesis was added. > > Can someone let me know how I can get rid of these parenthesis? SetAttributes[CircleTimes,Flat] f[{a,b,c,d}] a[CircleTimes]b[CircleTimes]c[CircleTimes]d Tom Burton ==== The Illinois Institute of Technology's Stuart Graduate School of Business in collaboration with Wolfram Research, Inc. is offering a seminar series on applications of the Mathematica software system in mathematical and computational finance. The weekly seminars will begin Friday, October 25, 2002, and will be held at the Stuart Graduate School of Business in Chicago. The speakers will illustrate the built-in functionality of Mathematica as well as the extensive Mathematica applications available from both Wolfram Research and independent developers. They will also give detailed synopses of applications that solve a wide range of financial problems. Advance registration is required. You can register by writing to seminar@wolfram.com. For more information, visit the seminar website at: http://www.wolfram.com/services/seminars/chicago2002/ ==== Allan, I would like to add something to this , something which duzznt deal with the question directly but with the answer...since I've seen it many times on the mathgroup forum, I feel i'd like to make a philosophical comment here...when I look at the reply and the solution , which might be perfectly good, but it makes me wonder...of what value is it to a Newbie????......quite often I seen questions posted Who can do this or that the fastest?....How about who can come up with a solution that is the easiest to comprehend?....Allan, I realize that you are an advanced user, etc..and that you think along these lines...but for me, and perhaps many others, I cant think along these lines even though I have read mathgroup for many years now...with that said, naturally i'm quite thankful to the 'gurus' who provide answers.... jerry blimbaum NSWC panama city, fl -----Original Message----- To get the function for the norm of the derivative we can use norm = Evaluate/@(Simplify/@(Sqrt[#.#]&/@(f'))) 2*Sqrt[2] & We map the usual functions for calclulating and simplifying the norm inside Function[.] (which is the full form of (.)& and then map the function Evaluation to make the result evaluate -- this is needed since Function has the attribute HoldAll. Please note that the parentheses are essential. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > > f[t_] = {t + Sqrt[3] Sin[t], 2 Cos[t], t Sqrt[3] - Sin[t]} > > So It's basically a vector whose coordinates are determined based on the > values you pass in. > > Then I took the derivative by just typing f', which outputs > > {1 + Sqrt[3] Cos[#1], -2 Sin[#1], Sqrt[3] - Cos[#1]}& > > > What I'd like to do is have Mathematica calculate the norm of this as it > would any vector, so that I can play with the norm function. As it turns > out, the norm in this case is identical to Sqrt[8], so it would be nice if > Mathematica could figure that out. Is it possible to do this? > > > ==== Dear Netters, I am also looking for Automated formal vector analysis. I am currently doing it with Mathematica and its package VectorAnalysis but it does not allow DIRECT algebra on tensors and vectors (or else I have not found how to do it) Can anyone else help ? Nicolas Fressengeas -- ________________________________________________________ Dr. Nicolas Fressengeas - - - http://www.ese-metz.fr/~fresseng Sup.8elec / Laboratoire Mat.8eriaux Optiques, Photonique et Syst.8fmes 2 rue E.Belin, 57070 METZ Cedex Plan d'acc.8fs: http://www.iti.fr/PlanPerso/23704/1 When everything else fails, read the instructions... Alexey Skoblikov a .8ecrit dans le message > Is there any tool for dealing with DIRECT tensor algebra, i.e. when tensor > is not a matrix of components, but considered to be the invariant object? > > ==== funcList = {Exp[x], Sin[y], z^3}; varList = {x, y, z}; MapThread[Plot[#1, {#2, -5, 5}] &, {funcList, varList}]; Inner[Plot[#1, {#2, -5, 5}] &, funcList, varList]; Bob Hanlon >how can I solve the following problem: The task is to successively plot > >the functions given in FuncList with the accociated variable > > >FuncList = {Exp[x], Sin[y], z^3}; > >VarList = {x, y, z}; > >Do[Plot[FuncList[LeftDoubleBracket] > i[RightDoubleBracket], {VarList[LeftDoubleBracket] > i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] ==== All you need is Evaluate in your code: Do[Plot[Evaluate[FuncList[[i]], {VarList[[i]], -5, 5}]], {i, 1, Length[VarList]}] or you might prefer: Plot[#1, {#2, -5, 5}] & @@@ Transpose[{FuncList, VarList}] Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > Dear colleagues, > > how can I solve the following problem: The task is to successively plot > the functions given in FuncList with the accociated variable > > > FuncList = {Exp[x], Sin[y], z^3}; > > VarList = {x, y, z}; > > Do[Plot[FuncList[LeftDoubleBracket] > i[RightDoubleBracket], {VarList[LeftDoubleBracket] > i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] > > Frank Brand > > > > > ==== (Somehow the original posting never reached me). But what's wrong with dfx[x_, t_] := Derivative[1, 0][f][x, t] ? Andrzej Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > > f[x_, t_] := Sin[x*t] > dfx[x_, t_] := Module[{y, df}, > df = D[f[y, t], y]; > Block[{y = x}, > df > ] > ] > > Jens > >> >> Dear Listers, >> >> I find myself defining functions in terms of differentiation. For >> example, >> >> f[x_,t_]:=Sin[x*t] >> dfx[x_,t]:=D[Sin[y,t],y]/.y->x >> >> This works well, but it seems to me that there should be a better way >> to do this. That is, there should be a better way to define a >> 'derivative' of a previous function without going through the >> replacement contortions. I can't find the answer in the archive. >> Can someone tell me the most straightforward way to do this? Will it >> work to define a gradient vector or Jacobian matrix? A Hessian >> matrix? >> >> -- >> Jason Miller, Ph.D. >> Division of Mathematics and Computer Science >> Truman State University >> 100 East Normal St. >> Kirksville, MO 63501 >> http://vh216801.truman.edu >> 660.785.7430 > > > ==== It seems that I am having problems in embedding the eps fonts in Mathematica generated files using the program emmathfnt from Mathsource. Currently, I am using version 4.2 and with the previous version 4.1, I did not have any problems with emmathfnt. This is what I am doing: In[90]:= gr=Plot[Sin[x], {x, 0, Pi}, FrameLabel[Rule] { [Alpha] , [Beta]}]; scratchFile=Export[Close[OpenTemporary[]],gr,EPS]; Run[C:WINNTemmathfnt,-o,temp,-d, C:Program FilesWolfram ResearchMathematica4.2SystemFilesFontsType1,scratc hFile] Out[92]= 0 The file is generated but the fonts are not included. Can some one tell me what I am doing wrong? Note the executable file emmathfnt is the same found on Mathsource and the location of the file is in C:WINNT. Also since I still have version 4.0 fonts, I tried the above Run command without the -d flag and I got the same result. Finally, one can not help but wonder, why there is no option in export that allow the fonts to be included in Mathematica generated figures for better portability. Wissam AlSaidi ==== Frank, The first method is just to Evaluate the iterator. FuncList = {Exp[x], Sin[y], z^3}; VarList = {x, y, z}; Do[Plot[FuncList[[i]], Evaluate[{VarList[[i]], -5, 5}]], {i, 1, Length[VarList]}] But a simpler method is to use functional programming... MapThread[Plot[#1, {#2, -5, 5}] &, {FuncList, VarList}]; David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ Frank Brand ==== I«m new, so I«m sorry if the question is so easy, I really think that is easy, but I don«t know how to do it. I have this: b=n-m a=x-b Y=3a + 4a^2 and the program show me this: 3(x-n+m) + 4(x-n+m)^2 or, something like that, the problem is that I want the program show me Y in function of b, or sometimes in function of a, something like this: Y=3(x-b) + 4(x-b)^2 or Y=3a + 4a^2 ==== Forget about procedural programming, i.e., no more Do's ever again. Use MapThread: In[1]:= FuncList={Exp[x],Sin[y],z^3}; VarList={x,y,z}; In[3]:= f[a_,b_]:=Plot[a,{b,-5,5}] In[4]:= MapThread[f,{FuncList,VarList}]; Oh, and try not to use uppercase letters in the first position of your functions and variable names. These are reserved for Mathematica built-in functions. Tomas Garza Mexico City ----- Original Message ----- > VarList = {x, y, z}; > > Do[Plot[FuncList[LeftDoubleBracket] > i[RightDoubleBracket], {VarList[LeftDoubleBracket] > i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] > > Frank Brand > > > ==== The solution is using Evaluate. In[1]:= FuncList = {Exp[x], Sin[y], z^3}; In[2]:= VarList = {x, y, z}; In[3]:= Do[Plot[Evaluate[FuncList[[i]], {VarList[[i]], -5, 5}]], {i, 1, Length[VarList]}] Greetings, Germ.87n Buitrago A. ----- Original Message ----- > VarList = {x, y, z}; > > Do[Plot[FuncList[LeftDoubleBracket] > i[RightDoubleBracket], {VarList[LeftDoubleBracket] > i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] > > Frank Brand > > > ==== Dear colleagues, how can I solve the following problem: The task is to successively plot the functions given in FuncList with the accociated variable FuncList = {Exp[x], Sin[y], z^3}; VarList = {x, y, z}; Do[Plot[FuncList[LeftDoubleBracket] i[RightDoubleBracket], {VarList[LeftDoubleBracket] i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] Frank Brand ==== Try something less clumsy, eg : Plot[#1,{#2,-5,5}]&@@@Transpose[{FuncList,VarList}] or why not have a particular symbol for the independent variable - then just map the plot command over the FuncList : Plot[#,{t,-5,5}]&/@{Exp[t],Sin[t],t^3} bye, Borut | Dear colleagues, | | how can I solve the following problem: The task is to successively plot | the functions given in FuncList with the accociated variable | | | FuncList = {Exp[x], Sin[y], z^3}; | | VarList = {x, y, z}; | | Do[Plot[FuncList[LeftDoubleBracket] | i[RightDoubleBracket], {VarList[LeftDoubleBracket] | i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] | | Frank Brand | | | ==== Frank, FuncList = {Exp[x], Sin[y], z^3}; VarList = {x, y, z}; MapThread[Plot[#1, {#2, -5, 5}] &, {FuncList, VarList}] -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Dear colleagues, > > how can I solve the following problem: The task is to successively plot > the functions given in FuncList with the accociated variable > > > FuncList = {Exp[x], Sin[y], z^3}; > > VarList = {x, y, z}; > > Do[Plot[FuncList[LeftDoubleBracket] > i[RightDoubleBracket], {VarList[LeftDoubleBracket] > i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] > > Frank Brand > > > Reply-To: kuska@informatik.uni-leipzig.de ==== FuncList = {Exp[x], Sin[y], z^3}; VarList = {x, y, z}; Plot[Evaluate[#[[1]], {#[[2]], -5, 5}]] & /@ Transpose[{FuncList, VarList}] Jens > > Dear colleagues, > > how can I solve the following problem: The task is to successively plot > the functions given in FuncList with the accociated variable > > FuncList = {Exp[x], Sin[y], z^3}; > > VarList = {x, y, z}; > > Do[Plot[FuncList[LeftDoubleBracket] > i[RightDoubleBracket], {VarList[LeftDoubleBracket] > i[RightDoubleBracket], -5, 5}], {i, 1, Length[VarList]}]] > > Frank Brand ==== Greetings This problem can be solved by conventional programming, but I wonder if there is an elegant Mathematica solution ? A list contains pairs of values, with each pair representing the lower and upper edge of a sub-range. Some of the sub-ranges partially overlap, some fully overlap, others don't overlap at all. The problem is to produce a second list that contains the overall upper and lower edges of the overlapping sub-ranges. A simple example : {{100,200},{150,250},{120,270},{300,400}} would result in {{100,270},{300,400}}. In the real case, the input list has several hundred elements and the output list typically has five elements. I have a working solution based on loops, but there must be a more elegant one. I would be very grateful for any suggestions. John Leary ==== John The simplest solution to your trial problem that I could come up with was the following: Apply[List, Apply[Interval, {{100, 200}, {150, 250}, {120, 270}, {300, 400}}]] I hope you can figure it out. I didn't test it on a larger input dataset - my usual experience is that built-in functions are faster for operations on lists than fiddling around with loops. Mark Westwood > > Greetings > > This problem can be solved by conventional programming, but I wonder if > there is an elegant Mathematica solution ? > > A list contains pairs of values, with each pair representing the lower and > upper edge of a sub-range. Some of the sub-ranges partially overlap, some > fully overlap, others don't overlap at all. The problem is to produce a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more elegant > one. I would be very grateful for any suggestions. > > > John Leary ==== I remember there being a similar thread on this subject a while ago, but I am too lazy to check it out. The simplest solution seems to be using Interval, although it may not be very fast. For example In[3]:= Interval[{100,200},{150,250},{120,270},{300,400}] Out[3]= Interval[{100, 270}, {300, 400}] If the above is not sufficiently fast for you, then you may want to search the archives for the thread I mentioned above. Carl Woll Physics Dept U of Washington > Greetings > > This problem can be solved by conventional programming, but I wonder if > there is an elegant Mathematica solution ? > > A list contains pairs of values, with each pair representing the lower and > upper edge of a sub-range. Some of the sub-ranges partially overlap, some > fully overlap, others don't overlap at all. The problem is to produce a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more elegant > one. I would be very grateful for any suggestions. > > > > John Leary > > ==== >Greetings > >This problem can be solved by conventional programming, but I wonder if >there is an elegant Mathematica solution ? > >A list contains pairs of values, with each pair representing the lower and >upper edge of a sub-range. Some of the sub-ranges partially overlap, some >fully overlap, others don't overlap at all. The problem is to produce a >second list that contains the overall upper and lower edges of the >overlapping sub-ranges. > >A simple example : {{100,200},{150,250},{120,270},{300,400}} would result >in {{100,270},{300,400}}. > >In the real case, the input list has several hundred elements and the >output list typically has five elements. > >I have a working solution based on loops, but there must be a more elegant >one. I would be very grateful for any suggestions. Block[{data = {{100,200},{150,250},{120,270}, {300,400}}}, data = Sort[data,#[[1]]<#2[[1]]&]; {{data[[1,1]], Fold[If[#<#2[[1]],#,Max[#,#2[[2]]]]&, data[[1,2]],Rest[data]]}, {Fold[If[#>#2[[2]],#,Min[#,#2[[1]]]]&, (data=Reverse@data)[[1,1]],Rest[data]], data[[1,2]]}}] --> {{100, 270}, {300, 400}} I haven't tested too extensively. The so-called Mathematica way is illustrated by the use of Fold function to process data, without which you must resort to conventional looping. DH ==== John, The solution using Split that I previously supplied may unnecessarily sort more than once -- here is a correction -- it should be slightly quicker.. lst = Table[{#, # + Random[Integer, {0, 9}]} &[ Random[Integer, {0, 1000}]], {1000}]; FixedPoint[{Min[#],Max[#]}&/@ Split[Sort[#], #1[[2]][GreaterEqual]#2[[1]]&]&,lst]//Timing {0.22 Second,{{1,64},{66,66},{67,175},{177,363},{365,548},{551,853},{857, 857},{858,938},{940,1003}}} FixedPoint[{Min[#],Max[#]}&/@Split[#, #1[[2]][GreaterEqual]#2[[1]]&]&, Sort[lst]]//Timing {0.16 Second,{{1,64},{66,66},{67,175},{177,363},{365,548},{551,853},{857, 857},{858,938},{940,1003}}} Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > Greetings > > This problem can be solved by conventional programming, but I wonder if > there is an elegant Mathematica solution ? > > A list contains pairs of values, with each pair representing the lower and > upper edge of a sub-range. Some of the sub-ranges partially overlap, some > fully overlap, others don't overlap at all. The problem is to produce a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more elegant > one. I would be very grateful for any suggestions. > > > > John Leary > > ==== ............. > A list contains pairs of values, with each pair representing the lower and > upper edge of a sub-range. Some of the sub-ranges partially overlap, some > fully overlap, others don't overlap at all. The problem is to produce a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. John, Generate a list of pairs: lst=Table[{#,#+Random[Integer,{0,9}]}&[Random[Integer,{0,1000}]],{1000}]; A slow solution Sort[lst]//. {x___,{a_,b_},{c_,d_},y___}/;c<=b:>{x,{a,Max[b,d]},y}//Timing {5. Second,{{0,219},{221,431},{432,568},{569,599},{600,697},{699,1005}}} A faster one FixedPoint[{Min[#],Max[#]}&/@Split[Sort[#], #1[[2]]>=#2[[1]]&]&, lst]//Timing {0.22 Second,{{0,219},{221,431},{432,568},{569,599},{600,697},{699,1005}}} -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 ==== >This problem can be solved by conventional programming, but I wonder if >there is an elegant Mathematica solution ? >A list contains pairs of values, with each pair representing the lower and >upper edge of a sub-range. Some of the sub-ranges partially overlap, some >fully overlap, others don't overlap at all. The problem is to produce a >second list that contains the overall upper and lower edges of the >overlapping sub-ranges. >A simple example : {{100,200},{150,250},{120,270},{300,400}} would result >in {{100,270},{300,400}}. >In the real case, the input list has several hundred elements and the >output list typically has five elements. If the numbers are all integers less than 401, as in your example, then you could start with the list {1,2,3,...400} and compare each number to every pair in your list-of-pairs. If there exists no pair that the given number falls between (inclusive), replace the number with zero. Converting the resulting list to the output you want is an exercise for the reader (clever replacement rules will do it easily). -- Tim Dellinger www.ews.uiuc.edu/~tdelling tdelling@uiuc.edu ==== Interval[{100, 200}, {150, 250}, {120, 270}, {300, 400}] does what you want. -- Steve Luttrell West Malvern, UK > Greetings > > This problem can be solved by conventional programming, but I wonder if > there is an elegant Mathematica solution ? > > A list contains pairs of values, with each pair representing the lower and > upper edge of a sub-range. Some of the sub-ranges partially overlap, some > fully overlap, others don't overlap at all. The problem is to produce a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more elegant > one. I would be very grateful for any suggestions. > > > > John Leary > > ==== Mathematica Training Course Whether youâre a beginner or seasoned professional, our training services can help you improve your Mathematica skills. We offer public and private training. Mathematica Intermediate & Programming Course (2 days) ----------------- Amsterdam, December 19-20 Mathematica is an exhaustive, powerful, and user-friendly software package. It is easy to perform basic calculations right way, but when you really want to explore and use the real power of Mathematica an investment is necessary. This course helps you making this investment and is meant for Mathematica users who want to know more about the background of Mathematica and to get a deeper understanding of the package; also you will learn how to use Mathematica more effectively. price: EUR 790 per person excluding VAT URL For more information and subscription: http://www.candiensten.nl/english/cursussen/cursussendetail.asp?id=9 How to register? ----------------- You may register on line via the links provided, or fill in the registration form below and return it to me or to Heleen Henneman. voice : +31 (0)20 5608400 fax : +31 (0)20 5608448 Please contact me if you have any questions. Dick Verkerk P.S. Feel free to share this information amongst friends and colleagues who might be interested! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Registration Form Herewith I register for the course: Mathematica Intermediate & Programming Course (2 days) [ ] Amsterdam, December 19-20 Name : M/F Function : Department : Institute : Address : Zip : City : November 1 Pricing derivatives with PDE (Partial Differential Equations) http://www.candiensten.nl/english/cursussen/cursussendetail.asp?id=41 Check out our complete list of courses at: http://www.candiensten.nl/english/cursussen/home.asp _________________________ Dick Verkerk, managing director CANdiensten, Nieuwpoortkade 23-25, NL-1055 RX Amsterdam voice: +31 20 5608410 fax: +31 20 5608448 verkerk@candiensten.nl _________________________ Your Partner in Finance and Mathematics! ==== > > Greetings, > > I have read with great interest this lively debate on numerical prcesion and > accuracy. As I work in the fields of finance and economics, where we feel > ourselves blessed if we get three digits of accuracy, I'm curious as to what > scientific endeavors require 50+ digits of precision? As I recall there are > some areas, such as high energy physics and some elements of astronomy, that > might require so many digits in some circumstances. Are there others? > > > -Mark > > I'm not sure what scientific endeavors might directly benefit. I can say that alot of computational endeavors need high precision, and of course some of these are used behind the scenes in scientific computation. Below I list a few. (i) Exact computation that uses approximation behind the scenes. Even someting so mundane as integer division can fall into this category. (ii) Finding relations among real or integer values can be done with high precision arithmetic. For example, one can implement LLL lattice reduction via approximate arithmetic. it's cousin, PSLQ, is entirely an approximate arithmetic procedure and at times it requires high precision. Applications of these would include cryptography and the like, hence this lies at least partly in the realm of applied math. (iii) Some algorithms may have low precision input but require higher precision at intermediate steps. An example is the method we use for solving systems of multivariate polynomial equations. You can regard the input as representing a family of problems (parametrized by the range of fuzz implied by the low precision input). Clearly the raising of precision in such circumstances is in some sense artificial, insofar as what we obtain is a solution to a particular member of the family (actually to a narrow subfamily). However we also make some attempt to detect ill conditioning; if the problem is well conditioned then solutions to all members of the family will be reasonably near to the one we obtain. (iv) Some statistical functions may require fairly high precision behind the scenes in order to obtain reasonable results for inputs that are not outrageous. This can often be mollified by changing the algorithm used but sometimes high precision is the simplest way to proceed. (v) Computational geometry problems frequently become nongeneric arithmetic can help to handle cases wherein nongenericity makes the problem pathological (often perturbation or similar devices are also needed). integration to counter various ills such as cancellation error. I'm sure there are oodles of other computational examples wherein high precision saves the day. The moral is that, while scientific examples rarely provide high precison input, methods of computation required by scientists may well still require high precision arithmetic. Also note that while financial forecasting may be blessed to get three digits, other aspects of the financial world require much more. Around 10 years ago a bank investigated purchasing Mathematica. Apparently they wanted to be certain they had amounts figured to better than the nearest penny (or so I heard). When working with exchange rates I suppose this could be important; crude rounding might allow for those weird secrets work. Wanna buy a Euro from me? Daniel Lichtblau Wolfram Research ==== > > > The more I play with the example the more > depressing it gets. Start > with floating point numbers but explicitly > arbitrary-precision ones. > > In[1]:= > a=77617.00000000000000000000000000000; > b=33095.00000000000000000000000000000; > > In[3]:= > !(333.7500000000000000000000000000000 b^6 + > a^2 ((11 a^2 > b^2 - > b^6 - 121 b^4 - 2)) + > 5.500000000000000000000000000000 b^8 + > a/(2 > b)) > > Out[3]= > > > !((-4.78339168666055402578083604864320577443814`26.6715*^32)) > > In[4]:= > Accuracy[%] > > Out[4]= > -6 > > Due to the manual section 3.1.6: > > When you do calculations with arbitrary-precision > numbers, as > discussed in the previous section, Mathematica > always keeps track of > the precision of your results, and gives only > those digits which are > known to be correct, given the precision of your > input. When you do > calculations with machine-precision numbers, > however, Mathematica > always gives you a machine[CapitalEth]precision result, > whether or not all the > digits in the result can, in fact, be determined > to be correct on the > basis of your input. > > Because I started with arbitrary-precision numbers > Mathematica should display > only those digits that are correct, that is none. > > No, 26 digits are correct > > Here is the number: > -0.8273960599468213681 > > Here is the same number computed by Mathematica with 26 > correct digits: > -4.78339168666055402578083604864320577443814[Times]10^32 > > It looks like I have been using some wrong definition > of correct.:-) > > You just proved that Precision is useless as a measure > how good your numerical result is. > > [...] I rather hope I proved nothing of the sort. Also I'm afraid Mathematica kept better track of the numbers than you did. As for definitions of correct, rather than remark on yours I'll just expose what I meant with specific numerical examples below. You did not actually say why you thought -0.8273960599468213681 would be the appropriate result. So I'll go through the computation in exact arithmetic (I have to admit I am puzzled as to why you did not do this). First I'll rewrite your expression using more variables. a = 77617.00000000000000000000000000000; b = 33095.00000000000000000000000000000; c = 333.7500000000000000000000000000000; d = 5.500000000000000000000000000000; In[6]:= InputForm[val = c*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + d*b^8 + a/(2*b)] Out[6]//InputForm= -4.78339168666055402578083604864320577443814`26.6715*^32 This is what I got. Now we'll redo in exact arithmetic. rata = Rationalize[a]; ratb = Rationalize[b]; ratc = Rationalize[c]; ratd = Rationalize[d]; In[12]:= InputForm[exactval = ratc*ratb^6 + rata^2* (11*rata^2*ratb^2 - ratb^6 -121*ratb^4 - 2) + ratd*ratb^8 + rata/(2*ratb)] Out[12]//InputForm= -63322539148012414193286707611938758031/132380 In[13]:= InputForm[N[exactval]] Out[13]//InputForm= -4.783391686660554*^32 I think it is reasonable to claim that these agree. I dug through some early posts on the topic and came across a value for b at one time that was one larger (this supports my long-held suspicion that numbers slowly decay in discrete increments...). In[14]:= b2 = 33096.00000000000000000000000000000; In[15]:= InputForm[val2 = c*b2^6 + a^2*(11*a^2*b2^2 - b2^6 - 121*b2^4 - 2) + d*b2^8 + a/(2*b2)] Out[15]//InputForm= -0.827469148`-0.3833 What this reveals is a number that Mathematica claims has NO trustworty digits. The InputForm also reveals the untrustworthy digits, and, sure enough, it comes close to what you have called the correct value, and specifically they agree to four places. My opinion is that the Mathematica significance arithmetic is doing, shall I say, precisely as it ought. Daniel Lichtblau Wolfram Research Reply-To: Mark Coleman ==== Greetings, I have read with great interest this lively debate on numerical prcesion and accuracy. As I work in the fields of finance and economics, where we feel ourselves blessed if we get three digits of accuracy, I'm curious as to what scientific endeavors require 50+ digits of precision? As I recall there are some areas, such as high energy physics and some elements of astronomy, that might require so many digits in some circumstances. Are there others? -Mark ==== > Greetings, > > I have read with great interest this lively debate on numerical prcesion and > accuracy. As I work in the fields of finance and economics, where we feel > ourselves blessed if we get three digits of accuracy, I'm curious as to what > scientific endeavors require 50+ digits of precision? As I recall there are > some areas, such as high energy physics and some elements of astronomy, that > might require so many digits in some circumstances. Are there others? > > > -Mark Mark, There may be occasions when the outcome of a real process is so sensitive to changes in input that unless we know very precisely what the input is then we can know very little about the outcome - chaotic processes are of this kind. The difficulty is real and no amount of computer power or clever progamming will do much about it. Another situation is when the the process is not so sensitive but calculating with our formula or programme introduces accumulates significant errors. Here is a very artificial example of the latter (I time the computation and find the MaximumMemory used in the session as we go through the example): ser=Normal[Series[Cos[#],{#,0,200}]]; MaxMemoryUsed[] 1714248 Calculating with machine number does not show much of a pattern ( I have deleted the graphics - please evaluate the code), pts= With[{ss=ser},Table[ {#,ss}&[x], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True]; MaxMemoryUsed[] {5.11 Second,Null} 1723840 Using bigfloat inputs with precision 20 shows some pattern: pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,20]], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {17.52 Second,Null} 1759664 Precision 40 does very well: pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,40]], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {19.38 Second,Null} 1797072 Now we might think the correct outcomes are showing up, and use an interpolating function for further , and faster, calculation. f=Interpolation[pts] InterpolatingFunction[{{50.000000,70.00000}},<>] pts= Table[ f[x],{x,50, 70, .1}];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {0.33 Second,Null} As a matter of interest, this is what happens if we substitute exact numbers (rationals and integers) for reals-- the computation takes an excessively long time and quite a bit more memory. pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,Infinity]], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {992.28 Second,Null} 2413808 This also shows that we may in fact want to replace exact inputs with bigfloats. I should be interested to hear of other example, really real one in particular. I imagine that there are many situations where trends and shapes are more important than specific values. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > > > > > > ==== In the real world of physics there are several subatomic level processes which can only be distinguished by small changes in the n-th decimal place. But there is one example which is fairly easy to comprehend, and that is the constancy of the speed of light in a vacuum regardless of reference frame, as proposed in Einstein's special theory of relativity. If this were true only to the 9th or 10th decimal place, or, for that matter, to the 50th place, then whoever managed to show that it was not really a constant would certainly be in Nobel Prize territory, and much of modern physics would need a rewrite. Kevin > Greetings, > > I have read with great interest this lively debate on numerical prcesion > and > accuracy. As I work in the fields of finance and economics, where we feel > ourselves blessed if we get three digits of accuracy, I'm curious as to > what > scientific endeavors require 50+ digits of precision? As I recall there > are > some areas, such as high energy physics and some elements of astronomy, > that > might require so many digits in some circumstances. Are there others? > > > -Mark . ==== > [...] This subthread gets difficult to follow with all the indenting and the like so I will edit a bit for clarity. Here is some input. f = SetPrecision[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; One question that arose is, as best I can phrase it, How might I set values for a and b and retain 100 digits of precision (or perhaps accuracy)? There are a few answers and which you like will depend on what you really want to do. (i) You can use a = SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; As has been pointed out a few times, this will give a number with 100 digits of precision. But that number will not resemble: Clear[a,b] a = SetPrecision[77617,100]; b = SetPrecision[33096,100]; 33375/100*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 11/2*b^8 + a/(2*b) or any of the equivalent variations that have been presented in this thread. (ii) You can make input exact before doing any approximate arithmetic wherein canellation error might arise. Using Rationalize, I show this below. Clear[a,b] f = 333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 5.5*b^8 + a/(2*b) f = Rationalize[f] In[39]:= Precision[N[f /. {a->77617,b->33096}, 100]] Out[39]= 100. (iii) You cannot do what you want because you work with low precision input and want a high precision result. > Assume that I want accuracy and precision of 100 for > f. You advice me to make experiments to find out, what > should be the initial precision and accuracy of a and > b to reach the requested accuracy and precision for f. > Notice, that you cannot just repeat I[26], we saw > already what happens. I have to re-type I[24], I[25], > I[26], I[27], I[28], and I[29] as many times as needed > to get f with accuracy and precision 100. I am curious to know how exactly you defined I[...]. It involves a protected symbol. In[54]:= I[a_] := a^2 SetDelayed::write: Tag Complex in I[a_] is Protected. Out[54]= $Failed As for obtaining requested accuracy or precision, I gave no such advice. If you begin with exact input this can be done via N as per response (ii) above. I did not do any experimenting but simply directed N[] to find the result to 100 digits precision. > Dan, you simply advocate to do MANUAL WORK that should > be done by machine. See my above remark. > Let's suppose that in the above example I just want 60 > digits not 61. Precisely, I want 60 digits and nothing > or zeros afterwards. Let's see if I could use > SetAccuracy. > > In[30]:= > SetAccuracy[%, 60] > > Out[30]= > -0.82739605994682136814116509547981629199903311578438481991781 > > In[31]:= > % // FullForm > > Out[30]//FullForm= > -0.827396059946821368141165095479816291999033115784384819917814841672467988` > 59.9177 > > Oops, it did not work (as expected). Actually it did. You have 59.9177 digits of precision. If you check you will find that you have 60. digits of accuracy as you had requested. > [...] > Dan, is there any simple way to get what I want? If what you wanted was a number with 60 digits accuracy (which certainly was what you requested), then indeed you got it. > As I repeated already number of times, at this stage > of the development of computer technology, software > should do it for me (!). We both know that this is > doable. Some of the textbooks that you just advised me > to read describe it. As a developer of Mathematica, > tell us why do you consider this to be a bad idea? > > Peter Kosta First I must request references since I am not certain what exactly you have in mind that the software will do. Then I'll comment on what, as best I can assess, you seem to want the software to do. Based on prior notes from you in this thread, it appears that you want it to treat a number such as 1.2 as an exact entity 5/6. This can be done by exact methods, e.g. preprocessing so that all numbers get rationalized. It cannot be done by our numerical engine (or any other), as that will not rationalize for you. It can also be done by you working with exact input. This would be a simple expedient, but quite effective. I would consider it to be a terrible idea to automatically rationalize every approximate number input and then to work with exact arithmetic. While I am not certain this is what you advocate, it is the only interpretation I can find with would allow for the sort of result you seem to expect. It is a terrible idea because it bypasses solid numerical methods that have been developed over several decades for handling computations accurately and reliably (subject to appropriate input!), and in reasonable time. It would entirely disable any functionality for which no exact methods are known, e.g. solving many ODEs, optimization, and the like. I could go on for a while but I my four typing fingers will get sore. I'll just finish by noting that it is a terrible idea because it would punish all users of numeric computation in Mathematica. I fail to see any useful purpose in that. Mind you, while I regard it as a terrible idea, I am still not certain that this was in fact what you propose. Again, it would be helpful to software) so I can see what it is you really want. Daniel Lichtblau Wolfram Research ==== > Here's an even more extreme result: > > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 50]; > a = 77617.; b = 33096.; > f > Precision[f] > > -1.180591620717411303424`71.0721*^21 > 71 > > 71.0721 digits of precision? I don't think so!! Either I am it altogether or you are just simply beating to death the point that in case of machine arithmetic (only!) Precision and Accuracy are purely formal and essentially meaningless. One can argue whether in this case there is any point of returning any value for Precision, or Accuracy (like 71 above, or -5 for Accuracy in the example that fooled me), but it's not a big deal and it most certainly does not make SetPrecision meaningless. On the contrary, SetPrecision is very useful and in fact it is SetPrecision that can tell you that the answer above is meaningless: In[8]:= f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 50]; a=SetPrecision[77617.,$MachinePrecision]; b = SetPrecision[ 33096.,$MachinePrecision]; In[10]:= {f,Precision[f]} Out[10]= {1.19801754103509`0*^19, 0} I would say this is correct and show that SetPrecision is very useful indeed. It tells you (what of course you ought to already know in this case anyway) that machine precision will not give you a realiable answer in this case. If you know your numbers with a great deal of accuracy you can get an accurate answer: In[24]:= f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; a=SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; In[26]:= {f, Precision[f]} Out[26]= {-0.82739605994682136814116509547981629199903311578438481991 781484167246798617832`61.2597, 61} Again you can be pretty sure that you got an accurate answer, provided of course your original setting of precision was valid. Honestly, to say that SetPrecision and SetAccuaracy are useless is one of the silliest thing I have read on this list in years. > Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ ==== > > >[...] > > I would say this is correct and show that SetPrecision is very useful > indeed. It tells you (what of course you ought to already know in this > case anyway) that machine precision will not give you a realiable > answer in this case. If you know your numbers with a great deal of > accuracy you can get an accurate answer: > > In[24]:= > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > a=SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; > > > In[26]:= > {f, Precision[f]} > > Out[26]= > {-0.82739605994682136814116509547981629199903311578438481991 > 781484167246798617832`61.2597, 61} > > > Congratulations! You just requested accuracy of 100 for f and got 61 ( > to convince yourself add Accuracy[f] to In[26]). If In[24] one > replaces SetAccuracy by SetPrecision the result is similar. > > PK > [...] One has (initially) an accuracy of 100 for an expression that contains variables. In[25]:= Clear[a,b,f] In[26]:= f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; In[27]:= Accuracy[f] Out[27]= 100. Now we assign values to some indeterminants in f. In[28]:= a = SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; In[29]:= {f, Precision[f], Accuracy[f]} Out[29]= {-0.8273960599468213681411650954798162919990331157843848199178148, 61.2599, 61.3422} The precision and accuracy has dropped. This is all according to standard numerical analysis regarding cancellation error. You'll find it in any textbook on the topic. As for what happens when you artificially raise precision (or accuracy) of machine numbers far beyond that guaranteed by their internal representation, that falls into to category of garbage in, garbage out. It is, howoever, valid to use SetPrecision to raise precision in (typically iterative) algorithms where significance arithmetic might be unduly pessimistic due to incorrect assumptions about uncorollatedness of numerical error. Examples of such usage have appeared in this news group. Daniel Lichtblau Wolfram Research ==== > >[...] > > I would say this is correct and show that SetPrecision is very useful > indeed. It tells you (what of course you ought to already know in this > case anyway) that machine precision will not give you a realiable > answer in this case. If you know your numbers with a great deal of > accuracy you can get an accurate answer: > > In[24]:= > f = SetAccuracy[333.75*b^6 + a^2*(11*a^2*b^2 - b^6 - > 121*b^4 - 2) + 5.5*b^8 + a/(2*b), 100]; > a=SetPrecision[77617.,100]; b = SetPrecision[33096.,100]; > > > In[26]:= > {f, Precision[f]} > > Out[26]= > {-0.82739605994682136814116509547981629199903311578438481991 > 781484167246798617832`61.2597, 61} > Congratulations! You just requested accuracy of 100 for f and got 61 ( to convince yourself add Accuracy[f] to In[26]). If In[24] one replaces SetAccuracy by SetPrecision the result is similar. PK > Again you can be pretty sure that you got an accurate answer, provided > of course your original setting of precision was valid. > > Honestly, to say that SetPrecision and SetAccuaracy are useless is one > of the silliest thing I have read on this list in years. > > > > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ ==== I've been trying to use PlotVectorField for the following differential equation: dy/dt = 0.08*y*(1-y/1000) but I haven't been successful yet. I tried to do the following: f[t_, y_] := {1, 0.08*y*(1 - y/1000)} < 1]; -- Steve Luttrell West Malvern, UK > I've been trying to use PlotVectorField for the > following differential equation: > dy/dt = 0.08*y*(1-y/1000) > but I haven't been successful yet. > I tried to do the following: > f[t_, y_] := {1, 0.08*y*(1 - y/1000)} > < PlotVectorField[f[t, y], {t, 0, 80}, {y, 0, 1400}]; > but I'm getting a meaningless plot so I'd appreciate > if someone could tell me what is what I'm doing wrong. > Ruben > > __________________________________________________ > Do you Yahoo!? > http://faith.yahoo.com > ==== Dear group, I have the following question regarding a lengthy calculation using Mathematica: For given w points in x direction and h points in y direction, I can construct all the points using h=10; w=8; points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] Next, I need to find all the possible pairs of point including points themselves, i.e., pair AA. I can use pairs=Outer[List,points,points,1] Then, I have to clear those pairs that repeat themselves, i.e., pair AB and pair BA. Also, when w and h are of the order of 1000s, the computation takes a very long time. Is there a better way of doing the second part of Sincerely Cheng ==================================================== Cheng Liu, Ph.D. MST-8, Structure/Property Relations Materials Science and Technology Division Los Alamos National Laboratory Los Alamos, New Mexico 87545 ==================================================== ==== Cheng, If you have h and w on the order of 1000, then your points list will have 10^6 points in it. If you then want to have a list of every possible pair of points, that list will consist of 10^12 pairs. Each pair of points consists of 4 integers, so that means your pairs list will have 4 10^12 integers in it. Even if Mathematica could store each integer using 4 bytes, that would require over 10^13 bytes, or 10000 gigabytes of storage. In order for Mathematica to function efficiently, the above storage must be in memory and not in virtual memory on the hard drive. In other words, creating such a pairs list is impossible at the present time, and is probably impossible for the forseeable future. If you truly need such a pairs list, then you may be able to work with h and w on the order of 100 if you have a large amount of memory. What in the world are you trying to do? I doubt that creating such a pairs list is necessary for you to accomplish whatever it is you are trying to do. Carl Woll Physics Dept U of Washington > Dear group, > > I have the following question regarding a lengthy calculation > using Mathematica: > > For given w points in x direction and h points in y direction, I can > construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > > Next, I need to find all the possible pairs of point including points > themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > > Then, I have to clear those pairs that repeat themselves, i.e., pair AB and > pair BA. Also, when w and h are of the order of 1000s, the computation > takes a very long time. Is there a better way of doing the second part of > > Sincerely > > Cheng > > > ==================================================== > Cheng Liu, Ph.D. > MST-8, Structure/Property Relations > Materials Science and Technology Division > Los Alamos National Laboratory > Los Alamos, New Mexico 87545 > > ==================================================== > > ==== Here is a way with symbolic lists. (* Here are some sample lists*) lst1={A,B}; lst2={a,b,c}; (*Join into one list*) list1=Join[lst1,lst2]; (*Do the outer product to get all possible ordered pairs*) list2=Partition[Flatten[Outer[List,list1,list1]],2] {{A, A}, {A, B}, {A, a}, {A, b}, {A, c}, {B, A}, {B, B}, {B, a}, {B, b}, {B, c}, {a, A}, {a, B}, {a, a}, {a, b}, {a, c}, {b, A}, {b, B}, {b, a}, {b, b}, {b, c}, {c, A}, {c, B}, {c, a}, {c, b}, {c, c}} (*Turn the pairs into products*) list3=list2/.{x_,y_}¨{x y} {{A^2}, {A*B}, {a*A}, {A*b}, {A*c}, {A*B}, {B^2}, {a*B}, {b*B}, {B*c}, {a*A}, {a*B}, {a^2}, {a*b}, {a*c}, {A*b}, {b*B}, {a*b}, {b^2}, {b*c}, {A*c}, {B*c}, {a*c}, {b*c}, {c^2}} (*Union weeds out repeats*) list4=Union[list3,list3] {{a^2}, {a*A}, {A^2}, {a*b}, {A*b}, {b^2}, {a*B}, {A*B}, {b*B}, {B^2}, {a*c}, {A*c}, {b*c}, {B*c}, {c^2}} (*Now turn the products back into pairs*) (*This is the step the requires symbols*) list5=list4/.{x_^2}¨{x,x}/.{x_*y_}¨{x,y} {{a, a}, {a, A}, {A, A}, {a, b}, {A, b}, {b, b}, {a, B}, {A, B}, {b, B}, {B, B}, {a, c}, {A, c}, {b, c}, {B, c}, {c, c}} (*List it out*) (*If you have numbers, you can now use a Rule to replace*) Sort[lst]//TableForm -- Kevin J. McCann Joint Center for Earth Systems Technology (JCET) Department of Physics UMBC Baltimore MD 21250 > Dear group, > > I have the following question regarding a lengthy calculation > using Mathematica: > > For given w points in x direction and h points in y direction, I can > construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > > Next, I need to find all the possible pairs of point including points > themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > > Then, I have to clear those pairs that repeat themselves, i.e., pair AB and > pair BA. Also, when w and h are of the order of 1000s, the computation > takes a very long time. Is there a better way of doing the second part of > > Sincerely > > Cheng > > > ==================================================== > Cheng Liu, Ph.D. > MST-8, Structure/Property Relations > Materials Science and Technology Division > Los Alamos National Laboratory > Los Alamos, New Mexico 87545 > > ==================================================== > > ==== Oops! I didn't read the question properly. I hope I have got it right this time. Union[Map[Sort, pairs]] does what you want. -- Steve Luttrell West Malvern, UK > Dear group, > > I have the following question regarding a lengthy calculation > using Mathematica: > > For given w points in x direction and h points in y direction, I can > construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > > Next, I need to find all the possible pairs of point including points > themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > > Then, I have to clear those pairs that repeat themselves, i.e., pair AB and > pair BA. Also, when w and h are of the order of 1000s, the computation > takes a very long time. Is there a better way of doing the second part of > > Sincerely > > Cheng > > > ==================================================== > Cheng Liu, Ph.D. > MST-8, Structure/Property Relations > Materials Science and Technology Division > Los Alamos National Laboratory > Los Alamos, New Mexico 87545 > > ==================================================== > > ==== Cases[pairs, _?(#[[1]] != #[[2]] &)] does what you want. -- Steve Luttrell West Malvern, UK > Dear group, > > I have the following question regarding a lengthy calculation > using Mathematica: > > For given w points in x direction and h points in y direction, I can > construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > > Next, I need to find all the possible pairs of point including points > themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > > Then, I have to clear those pairs that repeat themselves, i.e., pair AB and > pair BA. Also, when w and h are of the order of 1000s, the computation > takes a very long time. Is there a better way of doing the second part of > > Sincerely > > Cheng > > > ==================================================== > Cheng Liu, Ph.D. > MST-8, Structure/Property Relations > Materials Science and Technology Division > Los Alamos National Laboratory > Los Alamos, New Mexico 87545 > > ==================================================== > > Reply-To: ==== If we have inaccurately known parameters, I think Interval arithmetic does a far better job of assessing the situation. As for impossible demands on memory and time, the computation that took 992.3 seconds for you took 32.8 seconds for me. Anyway, it can be done faster AND more accurately without bignums: Timing[pts = With[{ss = ser}, Table[({#1, ss} & )[x], {x, 50, 70, 1/10}]]; ] ListPlot[pts, PlotJoined -> True, PlotRange -> All]; MaxMemoryUsed[] {10.640999999999998*Second, Null} In any case, we spent far more time writing code and evaluating results than waiting on execution. If anything, your examples suggest only that machine precision AND bignum computations are suspect. The results may or may not be worth the pixels they take up on my screen, and unless I compute in some alternative way instead -- or use progressively more digits in bignums until things settle down -- I can only guess at their reliability. For an application such as your example, I think the best solution is to use infinite precision for a limited number of points, and then Interpolation. It's safer than using SetPrecision because it doesn't involve guessing how many digits of precision to use, and it's far faster because it doesn't involve testing higher and higher levels of precision. The choice of points for exact computation may be tricky, but there are adaptive algorithms for that. Here's an interesting way to proceed, for instance: ser = Normal[Series[Cos[x], {x, 0, 200}]]; Timing[pts = Table[{x, ser}, {x, 50, 70, 1/2}];] f = Interpolation[pts]; Timing[plot1 = Plot[f[x], {x, 50, 70}, PlotPoints -> 30, PlotDivision -> 3];] Cases[plot1, Line[a__] -> a, Infinity][[1, All, 1]]; Timing[newPts = Union[pts, ({x, ser} /. x -> #) & /@ (Rationalize[#, 1/100] & /@ %)];] g = Interpolation[newPts, InterpolationOrder -> 5]; plot1 = Plot[Cos[x] - g[x], {x, 50, 70}, PlotRange -> All]; {1.703000000000003*Second, Null} {0.1560000000000059*Second, Null} {4.968999999999994*Second, Null} {0.546999999999997*Second, Null} Length[pts] Length[newPts] 41 124 I used only a few points for the first plot and it already looked good. Just to be sure, I used Plot to select more points, and used infinite precision computation again for those points. The final Plot shows error limited to about 10^-6. Increasing InterpolationOrder decreases errors significantly, too, at fairly small cost. Bobby -----Original Message----- >However, if the coefficients and powers of your example series were not > perfectly known, what then? We need to distinguish between having an exact value which is imperfectly known and not having an exact value - having a range of values. If I may speculate a little more on real uses: - If we have inaccurately known parameters that do have definite values we may still want to calculae accurately over possible ranges of the parameter; and if the definite values give distinctive outcomes then testing with high accuracy inputs is a way of getting a more accurate determination of the real value - rather like using an inverse function. - if parameters do not have a definite value then we are into statistics, however we might still need to know the outcomes of inputing accurate values to get an idea of the behaviour of the process. Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 ----- Original Message ----- > adding arbitrary digits serves no purpose. Yes, plots may get smoother > as more digits are added, but they would not converge to a correct > result -- merely to a precise one. > > (In the chemistry industry where my wife works, the difference between > accuracy and precision is well known. Precision means getting the same > answer over and over --- whether it's right or not. Accuracy means > getting the right answer --- whether it's precise or not. It's low > variance versus small bias.) > > Modify your example like this: > > ser = N@Normal[Series[Cos[#], {#, 0, 200}]]; > Timing[pts = With[{ss = > ser}, Table[SetPrecision[{#, ss}, 80] &@x, {x, 50., 70., .1}]];] > ListPlot[pts, PlotJoined -> True, PlotRange -> All]; > MaxMemoryUsed[] > > Once the series coefficients have lost precision, you can't get it back > again. Furthermore, in using SetPrecision, there's a danger that one > could THINK he has regained it. > > Bobby > > -----Original Message----- > Sent: Tuesday, October 15, 2002 3:18 AM > To: mathgroup@smc.vnet.net > > > Greetings, > > I have read with great interest this lively debate on numerical > prcesion > and > accuracy. As I work in the fields of finance and economics, where we > feel > ourselves blessed if we get three digits of accuracy, I'm curious as > to > what > scientific endeavors require 50+ digits of precision? As I recall > there > are > some areas, such as high energy physics and some elements of > astronomy, > that > might require so many digits in some circumstances. Are there others? > > > -Mark > > > Mark, > > There may be occasions when the outcome of a real process is so > sensitive > to changes in input that unless we know very precisely what the input is > then we can know very little about the outcome - chaotic processes are > of > this kind. The difficulty is real and no amount of computer power or > clever > progamming will do much about it. > > Another situation is when the the process is not so sensitive but > calculating with our formula or programme introduces accumulates > significant > errors. > > Here is a very artificial example of the latter (I time the computation > and > find the MaximumMemory used in the session as we go through the > example): > > ser=Normal[Series[Cos[#],{#,0,200}]]; > > MaxMemoryUsed[] > > 1714248 > > Calculating with machine number does not show much of a pattern ( I > have > deleted the graphics - please evaluate the code), > > > pts= With[{ss=ser},Table[ {#,ss}&[x], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True]; > MaxMemoryUsed[] > > {5.11 Second,Null} > > 1723840 > > Using bigfloat inputs with precision 20 shows some pattern: > > pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,20]], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {17.52 Second,Null} > > 1759664 > > > Precision 40 does very well: > > pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,40]], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {19.38 Second,Null} > > 1797072 > > Now we might think the correct outcomes are showing up, and use an > interpolating function for further , and faster, calculation. > > f=Interpolation[pts] > > InterpolatingFunction[{{50.000000,70.00000}},<>] > > pts= Table[ f[x],{x,50, 70, .1}];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {0.33 Second,Null} > > > As a matter of interest, this is what happens if we substitute exact > numbers > (rationals and integers) for reals-- > the computation takes an excessively long time and quite a bit more > memory. > > pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,Infinity]], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {992.28 Second,Null} > > 2413808 > > This also shows that we may in fact want to replace exact inputs with > bigfloats. > > > I should be interested to hear of other example, really real one in > particular. I imagine that there are many situations where trends and > shapes > are more important than specific values. > > -- > Allan > > --------------------- > Allan Hayes > Mathematica Training and Consulting > Leicester UK > www.haystack.demon.co.uk > hay@haystack.demon.co.uk > Voice: +44 (0)116 271 4198 > > > > > > > > > > > > > > > > > ==== Greetings, Is anyone aware of Mathematica code implementing statistical cluster analys= is, e.g., k-means method, etc.? -Mark ==== Bobby, You rightly point out that care should be exercised when using (high precision) bigfloats, but this should not obscure the proper use of them. I have suggested some uses that are valid subject to circumstances (raising precision) or essential (converting exact numbers to bigfloats to avoid impossible demands on memory and time) - Daniel Lichtblau gave others. >However, if the coefficients and powers of your example series were not > perfectly known, what then? We need to distinguish between having an exact value which is imperfectly known and not having an exact value - having a range of values. If I may speculate a little more on real uses: - If we have inaccurately known parameters that do have definite values we may still want to calculae accurately over possible ranges of the parameter; and if the definite values give distinctive outcomes then testing with high accuracy inputs is a way of getting a more accurate determination of the real value - rather like using an inverse function. - if parameters do not have a definite value then we are into statistics, however we might still need to know the outcomes of inputing accurate values to get an idea of the behaviour of the process. Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 ----- Original Message ----- > result -- merely to a precise one. > > (In the chemistry industry where my wife works, the difference between > accuracy and precision is well known. Precision means getting the same > answer over and over --- whether it's right or not. Accuracy means > getting the right answer --- whether it's precise or not. It's low > variance versus small bias.) > > Modify your example like this: > > ser = N@Normal[Series[Cos[#], {#, 0, 200}]]; > Timing[pts = With[{ss = > ser}, Table[SetPrecision[{#, ss}, 80] &@x, {x, 50., 70., .1}]];] > ListPlot[pts, PlotJoined -> True, PlotRange -> All]; > MaxMemoryUsed[] > > Once the series coefficients have lost precision, you can't get it back > again. Furthermore, in using SetPrecision, there's a danger that one > could THINK he has regained it. > > Bobby > > -----Original Message----- > Sent: Tuesday, October 15, 2002 3:18 AM > To: mathgroup@smc.vnet.net > > > Greetings, > > I have read with great interest this lively debate on numerical > prcesion > and > accuracy. As I work in the fields of finance and economics, where we > feel > ourselves blessed if we get three digits of accuracy, I'm curious as > to > what > scientific endeavors require 50+ digits of precision? As I recall > there > are > some areas, such as high energy physics and some elements of > astronomy, > that > might require so many digits in some circumstances. Are there others? > > > -Mark > > > Mark, > > There may be occasions when the outcome of a real process is so > sensitive > to changes in input that unless we know very precisely what the input is > then we can know very little about the outcome - chaotic processes are > of > this kind. The difficulty is real and no amount of computer power or > clever > progamming will do much about it. > > Another situation is when the the process is not so sensitive but > calculating with our formula or programme introduces accumulates > significant > errors. > > Here is a very artificial example of the latter (I time the computation > and > find the MaximumMemory used in the session as we go through the > example): > > ser=Normal[Series[Cos[#],{#,0,200}]]; > > MaxMemoryUsed[] > > 1714248 > > Calculating with machine number does not show much of a pattern ( I > have > deleted the graphics - please evaluate the code), > > > pts= With[{ss=ser},Table[ {#,ss}&[x], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True]; > MaxMemoryUsed[] > > {5.11 Second,Null} > > 1723840 > > Using bigfloat inputs with precision 20 shows some pattern: > > pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,20]], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {17.52 Second,Null} > > 1759664 > > > Precision 40 does very well: > > pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,40]], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {19.38 Second,Null} > > 1797072 > > Now we might think the correct outcomes are showing up, and use an > interpolating function for further , and faster, calculation. > > f=Interpolation[pts] > > InterpolatingFunction[{{50.000000,70.00000}},<>] > > pts= Table[ f[x],{x,50, 70, .1}];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {0.33 Second,Null} > > > As a matter of interest, this is what happens if we substitute exact > numbers > (rationals and integers) for reals-- > the computation takes an excessively long time and quite a bit more > memory. > > pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,Infinity]], > {x,50.,70., .1}]];//Timing > ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; > MaxMemoryUsed[] > > {992.28 Second,Null} > > 2413808 > > This also shows that we may in fact want to replace exact inputs with > bigfloats. > > > I should be interested to hear of other example, really real one in > particular. I imagine that there are many situations where trends and > shapes > are more important than specific values. > > -- > Allan > > --------------------- > Allan Hayes > Mathematica Training and Consulting > Leicester UK > www.haystack.demon.co.uk > hay@haystack.demon.co.uk > Voice: +44 (0)116 271 4198 > > > > > > > > > > > > > > > > > Reply-To: ==== You're using SetPrecision when infinite precision is a meaningful option -- when there's no doubt about the coefficients and powers in the series. Bignums clearly make the computation faster in that case. However, if the coefficients and powers of your example series were not perfectly known, what then? If they begin life as machine numbers, adding arbitrary digits serves no purpose. Yes, plots may get smoother as more digits are added, but they would not converge to a correct result -- merely to a precise one. (In the chemistry industry where my wife works, the difference between accuracy and precision is well known. Precision means getting the same answer over and over --- whether it's right or not. Accuracy means getting the right answer --- whether it's precise or not. It's low variance versus small bias.) Modify your example like this: ser = N@Normal[Series[Cos[#], {#, 0, 200}]]; Timing[pts = With[{ss = ser}, Table[SetPrecision[{#, ss}, 80] &@x, {x, 50., 70., .1}]];] ListPlot[pts, PlotJoined -> True, PlotRange -> All]; MaxMemoryUsed[] Once the series coefficients have lost precision, you can't get it back again. Furthermore, in using SetPrecision, there's a danger that one could THINK he has regained it. Bobby -----Original Message----- feel > ourselves blessed if we get three digits of accuracy, I'm curious as to what > scientific endeavors require 50+ digits of precision? As I recall there are > some areas, such as high energy physics and some elements of astronomy, that > might require so many digits in some circumstances. Are there others? > > > -Mark Mark, There may be occasions when the outcome of a real process is so sensitive to changes in input that unless we know very precisely what the input is then we can know very little about the outcome - chaotic processes are of this kind. The difficulty is real and no amount of computer power or clever progamming will do much about it. Another situation is when the the process is not so sensitive but calculating with our formula or programme introduces accumulates significant errors. Here is a very artificial example of the latter (I time the computation and find the MaximumMemory used in the session as we go through the example): ser=Normal[Series[Cos[#],{#,0,200}]]; MaxMemoryUsed[] 1714248 Calculating with machine number does not show much of a pattern ( I have deleted the graphics - please evaluate the code), pts= With[{ss=ser},Table[ {#,ss}&[x], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True]; MaxMemoryUsed[] {5.11 Second,Null} 1723840 Using bigfloat inputs with precision 20 shows some pattern: pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,20]], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {17.52 Second,Null} 1759664 Precision 40 does very well: pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,40]], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {19.38 Second,Null} 1797072 Now we might think the correct outcomes are showing up, and use an interpolating function for further , and faster, calculation. f=Interpolation[pts] InterpolatingFunction[{{50.000000,70.00000}},<>] pts= Table[ f[x],{x,50, 70, .1}];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {0.33 Second,Null} As a matter of interest, this is what happens if we substitute exact numbers (rationals and integers) for reals-- the computation takes an excessively long time and quite a bit more memory. pts= With[{ss=ser},Table[ {#,ss}&[SetPrecision[x,Infinity]], {x,50.,70., .1}]];//Timing ListPlot[pts, PlotJoined->True,PlotRange[Rule]All]; MaxMemoryUsed[] {992.28 Second,Null} 2413808 This also shows that we may in fact want to replace exact inputs with bigfloats. I should be interested to hear of other example, really real one in particular. I imagine that there are many situations where trends and shapes are more important than specific values. -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > > > > > > ==== Suppose f(x,y,z)=Boole[0 ==== Here's a very simple solution: v = {{100, 200}, {150, 250}, {120, 270}, {300, 400}}; Interval @@ v List @@ % Interval[{100, 270}, {300, 400}] {{100, 270}, {300, 400}} DrBob -----Original Message----- second list that contains the overall upper and lower edges of the overlapping sub-ranges. A simple example : {{100,200},{150,250},{120,270},{300,400}} would result in {{100,270},{300,400}}. In the real case, the input list has several hundred elements and the output list typically has five elements. I have a working solution based on loops, but there must be a more elegant one. I would be very grateful for any suggestions. John Leary ==== > > Dear Fellows in MathGroup, > > I have a list of 17,000+ {x,y} pairs of data > > each x value is a positive integer from 1 to 100+ > > each y value is a positive real number > > As a *short* example, let's consider: > > data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} > > I want to group the data by the x value and report the arithmetic average > of the y values in each group. > > For the example, i want to report: > > output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} > > In this example, x=6 does not occur so i report the average y[6] = 0. > > Can anyone suggest a way to do this efficiently?/ > > many thanks > dave > > +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ > David E. Burmaster, Ph.D. > Alceon Corporation > POBox 382069 (new Box number effective 1 Sep 2001) > Harvard Square Station > Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) > > Voice 617-864-4300 > > Web http://www.Alceon.com > +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Probably most efficient would be to iterate over the list, bin, and then average the bins. averageByBin[data:{{_,_}..}] := Module[ {len, binsizes, averages}, len = Max[Map[First,data]]; binsizes = Table[0,{len}]; averages = Table[0,{len}]; Map [ (binsizes[[#[[1]]]]++; averages[[#[[1]]]] += #[[2]]) &, data]; Do [If[binsizes[[j]]==0, binsizes[[j]]++], {j,len}]; Transpose[{Range[len],N[averages]/binsizes}] ] In[30]:= averageByBin[data] Out[30]= {{1, 8.}, {2, 5.}, {3, 1.5}, {4, 2.5}, {5, 2.}, {6, 0.}, {7, 1.}} If you separate out integer first values from real second values in the pairs, you can enter two separate lists and take advantage of Compile to make it faster still. Daniel Lichtblau Wolfram Research ==== Dear Fellows in MathGroup, I have a list of 17,000+ {x,y} pairs of data each x value is a positive integer from 1 to 100+ each y value is a positive real number As a *short* example, let's consider: data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} I want to group the data by the x value and report the arithmetic average of the y values in each group. For the example, i want to report: output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} In this example, x=6 does not occur so i report the average y[6] = 0. Can anyone suggest a way to do this efficiently?/ many thanks dave +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ David E. Burmaster, Ph.D. Alceon Corporation POBox 382069 (new Box number effective 1 Sep 2001) Harvard Square Station Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) Voice 617-864-4300 Web http://www.Alceon.com +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ==== One typical idea for your application is to sort the data and then use Split. For example, ({#1[[1,1]], Plus @@ #1[[All,2]]/Length[#1]} & ) /@ Split[Sort[data], #1[[1]] == #2[[1]] & ]; The only difference between the above function and your desired result is that when there is no data for a particular integer, the average for that integer does not appear in the answer. Carl Woll Physics Dept U of Washington > Dear Fellows in MathGroup, > > I have a list of 17,000+ {x,y} pairs of data > > each x value is a positive integer from 1 to 100+ > > each y value is a positive real number > > As a *short* example, let's consider: > > data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} > > I want to group the data by the x value and report the arithmetic average > of the y values in each group. > > For the example, i want to report: > > output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} > > In this example, x=6 does not occur so i report the average y[6] = 0. > > Can anyone suggest a way to do this efficiently?/ > > many thanks > dave > > > > +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ > David E. Burmaster, Ph.D. > Alceon Corporation > POBox 382069 (new Box number effective 1 Sep 2001) > Harvard Square Station > Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) > > Voice 617-864-4300 > > Web http://www.Alceon.com > +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ > > > > ==== >Dear Fellows in MathGroup, > >I have a list of 17,000+ {x,y} pairs of data > > each x value is a positive integer from 1 to 100+ > > each y value is a positive real number > >As a *short* example, let's consider: > > data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} > >I want to group the data by the x value and report the arithmetic average >of the y values in each group. > >For the example, i want to report: > > output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} > >In this example, x=6 does not occur so i report the average y[6] = 0. > >Can anyone suggest a way to do this efficiently?/ Block[{data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6}, {5,2},{2,5},{7,1}}, sd = Table[{0,0.},{10}]}, Off[Infinity::indet]; Off[General::dbyz]; (sd[[#[[1]],2]]++;sd[[#[[1]],1]]+=#[[2]])&/@data; sd=MapIndexed[{#2[[1]],Divide@@#}&,sd]; On[Infinity::indet]; On[General::dbyz]; sd/.Indeterminate->0.] --> {{1, 8.}, {2, 5.}, {3, 1.5}, {4, 2.5}, {5, 2.}, {6, 0.}, {7, 1.}, {8, 0.}, {9, 0.}, {10, 0.}} This makes 3 linear passes overall on the data. For large data sets, that may be a problem. DH ==== > Dear Fellows in MathGroup, > > I have a list of 17,000+ {x,y} pairs of data > > each x value is a positive integer from 1 to 100+ > > each y value is a positive real number > > As a *short* example, let's consider: > > data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} > > I want to group the data by the x value and report the arithmetic average > of the y values in each group. > > For the example, i want to report: > > output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} > > In this example, x=6 does not occur so i report the average y[6] = 0. > > Can anyone suggest a way to do this efficiently?/ > > many thanks > dave Dave, One way: data={{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}}; f[x_] = 0; ((f[#1[[1,1]]] = Plus @@ #1[[All,2]]/Length[#1]) & ) /@ Split[Sort[data], #1[[1]] == #2[[1]] & ] {8, 5, 3/2, 5/2, 2, 1} Table[f[i], {i, 1, 8}] {8, 5, 3/2, 5/2, 2, 0, 1, 0} -- Allan --------------------- Allan Hayes Mathematica Training and Consulting Leicester UK www.haystack.demon.co.uk hay@haystack.demon.co.uk Voice: +44 (0)116 271 4198 > > > > +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ > David E. Burmaster, Ph.D. > Alceon Corporation > POBox 382069 (new Box number effective 1 Sep 2001) > Harvard Square Station > Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) > > Voice 617-864-4300 > > Web http://www.Alceon.com > +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ > > > > ==== Perhaps Numerical Recipes in C++ ----- Original Message ----- constants > and addition for example. I currently do this all with Mathematica but for > large symbolic calculations involving many operations Mathematica becomes quite > slow. (at least with my coding ability ;) ) Does anyone have any > recommendations for a c++ book along these lines? Simply put, I basically > want to write c++ code that functions similarly to mathematica but that > is specialized to particlar types of algebraic problems and therefore > runs faster. Any suggestions? > > -chris > > > > ==== I'm looking for a book recommendation. I've been using mathematica and I love it. I'd like to speed up some of my Mathematica codes though. What I really want to do is code some basic algrebraic steps in a lower level language. I need to somehow set up c/c++ code for operators, how they multiply, and also deal with multiplicative constants and addition for example. I currently do this all with Mathematica but for large symbolic calculations involving many operations Mathematica becomes quite slow. (at least with my coding ability ;) ) Does anyone have any recommendations for a c++ book along these lines? Simply put, I basically want to write c++ code that functions similarly to mathematica but that is specialized to particlar types of algebraic problems and therefore runs faster. Any suggestions? -chris ==== > I've been trying to use PlotVectorField for the > following differential equation: > dy/dt = 0.08*y*(1-y/1000) > but I haven't been successful yet. > I tried to do the following: > f[t_, y_] := {1, 0.08*y*(1 - y/1000)} > < PlotVectorField[f[t, y], {t, 0, 80}, {y, 0, 1400}]; > but I'm getting a meaningless plot so I'd appreciate > if someone could tell me what is what I'm doing wrong. > Ruben Just a thought, but have you checked your function for typos? As you've written it, f is only a function of y .... Dave. ==== > Greetings > > This problem can be solved by conventional programming, but I wonder if > there is an elegant Mathematica solution ? > > A list contains pairs of values, with each pair representing the lower > and > upper edge of a sub-range. Some of the sub-ranges partially overlap, > some > fully overlap, others don't overlap at all. The problem is to produce > a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would > result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more > elegant > one. I would be very grateful for any suggestions. > > I'm not sure about elegance, but I will tell you my approach to the problem. The general algorithm would seem to be: sort the ranges such that the first range has a left edge smaller than all other ranges. If two ranges have matching left edges, sort them according to their right edge. While there are two or more ranges in the list, operate on the rest of the list, compare the first range to the result of operating on the rest of the list. If the right edge of the first edge is larger than the left edge of the first element of the result return a list with the first element being a range with the left edge of the first range and the right being the larger of the right edge of the first element or the right edge of the first range in the result of operating on the list. That statement probably isn't very clear, it's a good thing I'm not employed as a teacher. Here is code which is probably easier to follow: (*Handle some degenerate cases here *) compress[{}] := {}; compress[lst : {{_?NumericQ, _?NumericQ}}] := lst (*This pattern is the stopping point of the recursion*) compress[rng : {_?NumericQ, _?NumericQ}, {}] := {rng} (*This function operates on the rest of the list then creates the first element appropriately*) compress[rng : {_? NumericQ, _?NumericQ}, lst : {{_?NumericQ, _?NumericQ} ..}] := With[{tl = compress[First[lst], Rest[lst]]}, If[rng[[2]] > Last[tl][[2]], {rng}, If[rng[[2]] > tl[[1, 1]], {{rng[[1]], If[tl[[1, 2]] > rng[[2]], tl[[1, 2]], rng[[2]]]}, Sequence @@ Rest[tl]}, {rng, Sequence @@ tl}]]] (*This function sorts the list properly then starts the recursion*) compress[lst : {{_?NumericQ, _?NumericQ} ..}] := With[{s = Sort[lst]}, compress[First[s], Rest[s]]] You will probably have to increase $RecursionLimit. This algorithm ran in 2 seconds on a list of 1000 elements on a 1GHz G4 PowerMac. There are probably optimizations that can be made though. Ssezi ==== Ruben, Your plot looks bad because PlotVectorField uses AspectRatio->Automatic, which means that the t and y axes are at the same scale. This makes the plot very high and narrow. Try the following... PlotVectorField[f[t, y], {t, 0, 80}, {y, 0, 1400}, AspectRatio -> 1, Frame -> True, ImageSize -> 450]; David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ but I'm getting a meaningless plot so I'd appreciate if someone could tell me what is what I'm doing wrong. Ruben __________________________________________________ Do you Yahoo!? http://faith.yahoo.com Reply-To: ==== You'll get more efficient methods from others, but I think the following is instructive: data = {{3, 1}, {4, 3}, {3, 2}, {1, 10}, {4, 2}, {1, 6}, {5, 2}, {2, 5}, {7, 1}}; ClearAll[total, count] total[x_] := 0 count[x_] := 0 {total[#[[1]]] += #[[2]], count[#[[1]]]++} & /@ data; ?total ?count {#, total[#]/count[#]} & /@ Union[data[[All, 1]]] DrBob -----Original Message----- of the y values in each group. For the example, i want to report: output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} In this example, x=6 does not occur so i report the average y[6] = 0. Can anyone suggest a way to do this efficiently?/ many thanks dave +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ David E. Burmaster, Ph.D. Alceon Corporation POBox 382069 (new Box number effective 1 Sep 2001) Harvard Square Station Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) Voice 617-864-4300 Web http://www.Alceon.com +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Reply-To: ==== It's not clear what you mean by pairs that repeat themselves, but does this do what you want? pairs = Flatten[Outer[List, points, points, 1], 1]; Map[Union, Map[Sort, pairs, 2], 1] DrBob -----Original Message----- themselves, i.e., pair AA. I can use pairs=Outer[List,points,points,1] Then, I have to clear those pairs that repeat themselves, i.e., pair AB and pair BA. Also, when w and h are of the order of 1000s, the computation takes a very long time. Is there a better way of doing the second part of Sincerely Cheng ==================================================== Cheng Liu, Ph.D. MST-8, Structure/Property Relations Materials Science and Technology Division Los Alamos National Laboratory Los Alamos, New Mexico 87545 ==================================================== ==== David, You will probably get a lot of answers for this. Here is my entry. data = {{3, 1}, {4, 3}, {3, 2}, {1, 10}, {4, 2}, {1, 6}, {5, 2}, {2, 5}, {7, 1}}; First I will show it step-by-step. nmax = 10; Union[Join[data, Table[{i, 0}, {i, 1, nmax}]]] Split[%, #1[[1]] == #2[[1]] & ] Map[Last, %, {2}] (Plus @@ #1/Length[#1] & ) /@ % Transpose[{Range[nmax], %}] giving {{1, 0}, {1, 6}, {1, 10}, {2, 0}, {2, 5}, {3, 0}, {3, 1}, {3, 2}, {4, 0}, {4, 2}, {4, 3}, {5, 0}, {5, 2}, {6, 0}, {7, 0}, {7, 1}, {8, 0}, {9, 0}, {10, 0}} {{{1, 0}, {1, 6}, {1, 10}}, {{2, 0}, {2, 5}}, {{3, 0}, {3, 1}, {3, 2}}, {{4, 0}, {4, 2}, {4, 3}}, {{5, 0}, {5, 2}}, {{6, 0}}, {{7, 0}, {7, 1}}, {{8, 0}}, {{9, 0}}, {{10, 0}}} {{0, 6, 10}, {0, 5}, {0, 1, 2}, {0, 2, 3}, {0, 2}, {0}, {0, 1}, {0}, {0}, {0}} {16/3, 5/2, 1, 5/3, 1, 0, 1/2, 0, 0, 0} {{1, 16/3}, {2, 5/2}, {3, 1}, {4, 5/3}, {5, 1}, {6, 0}, {7, 1/2}, {8, 0}, {9, 0}, {10, 0}} This wraps it into one statement. nmax = 10; Transpose[{Range[nmax], (Plus @@ #1/Length[#1] & ) /@ Map[Last, Split[Union[Join[data, Table[{i, 0}, {i, 1, nmax}]]], #1[[1]] == #2[[1]] & ], {2}]}] {{1, 16/3}, {2, 5/2}, {3, 1}, {4, 5/3}, {5, 1}, {6, 0}, {7, 1/2}, {8, 0}, {9, 0}, {10, 0}} This times a case of 20000 pairs on an 800MHz machine. data2 = Table[{Random[Integer, {1, 100}], Random[Real, {0, 5}]}, {20000}]; nmax = 100; data = data2; Timing[Transpose[{Range[nmax], (Plus @@ #1/Length[#1] & ) /@ Map[Last, Split[Union[Join[data, Table[{i, 0}, {i, 1, nmax}]]], #1[[1]] == #2[[1]] & ], {2}]}]; ] {0.55 Second, Null} David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} In this example, x=6 does not occur so i report the average y[6] = 0. Can anyone suggest a way to do this efficiently?/ many thanks dave +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ David E. Burmaster, Ph.D. Alceon Corporation POBox 382069 (new Box number effective 1 Sep 2001) Harvard Square Station Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) Voice 617-864-4300 Web http://www.Alceon.com +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ==== I'm not 100% sure of this, but how about sortout[intervals_] := ({First[#1], Last[#1]} & ) /@ Sort /@ Flatten /@ Split[Sort[intervals], #1[[2]] >= #2[[1]] & ] ? Example: intrvls = Table[x = Random[Integer, {0, 30}]; {x, x + 2}, {10}] {{18, 20}, {2, 4}, {14, 16}, {1, 3}, {0, 2}, {16, 18}, {7, 9}, {19, 21}, {6, 8}, {6, 8}} sortout[intrvls] {{0, 4}, {6, 9}, {14, 21}} --- Selwyn Hollis > Greetings > > This problem can be solved by conventional programming, but I wonder if > there is an elegant Mathematica solution ? > > A list contains pairs of values, with each pair representing the lower and > upper edge of a sub-range. Some of the sub-ranges partially overlap, some > fully overlap, others don't overlap at all. The problem is to produce a > second list that contains the overall upper and lower edges of the > overlapping sub-ranges. > > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more elegant > one. I would be very grateful for any suggestions. > > > > John Leary > > > ==== John, Use the Interval routine. Interval @@ {{100, 200}, {150, 250}, {120, 270}, {300, 400}} List @@ % giving... Interval[{100, 270}, {300, 400}] {{100, 270}, {300, 400}} David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ in {{100,270},{300,400}}. In the real case, the input list has several hundred elements and the output list typically has five elements. I have a working solution based on loops, but there must be a more elegant one. I would be very grateful for any suggestions. John Leary ==== >I have a list of 17,000+ {x,y} pairs of data > > each x value is a positive integer from 1 to 100+ > > each y value is a positive real number > >As a *short* example, let's consider: > > data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} > >I want to group the data by the x value and report the arithmetic average >of the y values in each group. > >For the example, i want to report: > > output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} > >In this example, x=6 does not occur so i report the average y[6] = 0. > >Can anyone suggest a way to do this efficiently?/ > The basic approach is (Plus @@ #)/Length[#] & /@ Split[Sort[data], #1[[1]] == #2[[1]] &] {{1, 8}, {2, 5}, {3, 3/2}, {4, 5/2}, {5, 2}, {7, 1}} To fill in the gaps: dataAvg[data_] := Module[{val = First /@ data, xData}, xData = Join[data, {#, 0} & /@ Complement[Range[Max[val]], val]]; (Plus @@ #)/Length[#] & /@ Split[Sort[xData], #1[[1]] == #2[[1]] &]]; dataAvg[data] {{1, 8}, {2, 5}, {3, 3/2}, {4, 5/2}, {5, 2}, {6, 0}, {7, 1}} Bob Hanlon ==== >I«m new, so I«m sorry if the question is so easy, I really think that >is easy, but I don«t know how to do it. > >I have this: > >b=n-m > >a=x-b > >Y=3a + 4a^2 > >and the program show me this: >3(x-n+m) + 4(x-n+m)^2 > >or, something like that, the problem is that I want the program show >me Y in function of b, or sometimes in function of a, something like >this: > >Y=3(x-b) + 4(x-b)^2 > >or > >Y=3a + 4a^2 > Solve[{b == n - m, a == x - b, Y == 3a + 4a^2}, Y] {{Y -> a*(4*a + 3)}} Solve[{b == n - m, a == x - b, Y == 3a + 4a^2}, Y, a] // FullSimplify {{Y -> (4*b - 4*x - 3)*(b - x)}} Bob Hanlon ==== Boole (defined in the AddOn package Calculus`Integration`) is not written to deal with symbolic parameters. So you may do better to use better to use the built-in UnitStep function for which Mathematica knows more rules. In fact, if you do not mind getting an error message you can get something like your answer by mixing UnitStep and Boole: << Calculus`Integration` In[2]:= FullSimplify[Integrate[Boole[0 < x < y < 1]*UnitStep[z - y], {z, 0, 1}],y>0] Integrate::region: The region defined by 0ÁåzÁå1&&00] Out[3]= -(-1+y) UnitStep[x,1-y,-x+y] Note that this expresses exactly the same condition as (1-y)Boole[0 Suppose f(x,y,z)=Boole[0 over, say, z, i.e. Integrate[f[x,y,z],{z,0,1}]. One would expect to see > the > output like this (1-y)Boole[0 as an argument in the Boole function). Instead, an error appears > (warning) that the integration cannot be performed. > > How to resolve this issue so it produces a desired answer? > > Janusz. > > > > > ==== >This problem can be solved by conventional programming, but I wonder if > >there is an elegant Mathematica solution ? > >A list contains pairs of values, with each pair representing the lower >and >upper edge of a sub-range. Some of the sub-ranges partially overlap, some > >fully overlap, others don't overlap at all. The problem is to produce >a >second list that contains the overall upper and lower edges of the >overlapping sub-ranges. > >A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > >in {{100,270},{300,400}}. > >In the real case, the input list has several hundred elements and the >output list typically has five elements. > >I have a working solution based on loops, but there must be a more elegant > >one. I would be very grateful for any suggestions. > lst = {{100, 200}, {150, 250}, {120, 270}, {300, 400}}; List @@ Union @@ Interval /@ lst {{100, 270}, {300, 400}} List @@ Interval[Sequence @@ lst] {{100, 270}, {300, 400}} Bob Hanlon ==== In my opinion, the best way to learn C++ and code algorithms is to simply start using it. There is oodles of source on the web and at www.sf.net to help you along too. Matt -- http://mffm.darktech.org WSOLA TimeScale Audio Mod : http://mffmtimescale.sourceforge.net/ FFTw C++ : http://mffmfftwrapper.sourceforge.net/ Vector Bass : http://mffmvectorbass.sourceforge.net/ Multimedia Time Code : http://mffmtimecode.sourceforge.net/ ==== do any of you have a working qsum author indentification workbook you are willing to share? thanks ==== >-----Original Message----- >Sent: Wednesday, October 16, 2002 8:26 PM >To: mathgroup@smc.vnet.net > > >Dear group, > > I have the following question regarding a lengthy calculation >using Mathematica: > >For given w points in x direction and h points in y direction, I can >construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > >Next, I need to find all the possible pairs of point including points >themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > >Then, I have to clear those pairs that repeat themselves, >i.e., pair AB and >pair BA. Also, when w and h are of the order of 1000s, the >computation >takes a very long time. Is there a better way of doing the >second part of > >Sincerely > >Cheng > > >==================================================== >Cheng Liu, Ph.D. >MST-8, Structure/Property Relations >Materials Science and Technology Division >Los Alamos National Laboratory >Los Alamos, New Mexico 87545 > >==================================================== > > Cheng, you didn't tell about a specific order of your resulting pairs, so you not need Transpose in your first line: points = Flatten[Outer[List, Range[w], Range[h]], 1] Now build the pairs (for sake of clarity , let me call the points points = {p1, p2, p3, p4, p5}, of course you don't do that): Flatten[ With[{l = Length[points]}, Array[If[#1>#2, Unevaluated[Sequence[]], points[[{#1, #2}]]]&, {l, l}]], 1] {{p1, p1}, {p1, p2}, {p1, p3}, {p1, p4}, {p1, p5}, {p2, p2}, {p2, p3}, {p2, p4}, {p2, p5}, {p3, p3}, {p3, p4}, {p3, p5}, {p4, p4}, {p4, p5}, {p5, p5}} Alternatively you might do pairs = Outer[List, points, points, 1] Flatten[MapIndexed[Drop[#1, First[#2] - 1] &, pairs], 1] {{p1, p1}, {p1, p2}, {p1, p3}, {p1, p4}, {p1, p5}, {p2, p2}, {p2, p3}, {p2, p4}, {p2, p5}, {p3, p3}, {p3, p4}, {p3, p5}, {p4, p4}, {p4, p5}, {p5, p5}} ...try out which is faster. -- Hartmut Wolf ==== When I first sent my answer I thought there was no interaction between Boole and UnitStep at all,and that one could safely use UnitStep after loading the Calculus`Integration` package, but there seems to be more to it than I had assumed and it is not necessarily for the best. Consider first the following: In[1]:= FullSimplify[Integrate[UnitStep[x,y-x,z-y,1-z],{z,0,1}],y>0] Out[1]= -(-1+y) UnitStep[x,1-y,-x+y] No surprises here. Now let's load the package: In[2]:= <0] Integrate::region: The region defined by 0.89ÅÛz.89ÅÛ1&&x.89 Å´0&&-x+y.89Å´0&&1-z.89Å26 40&&-y+z.89Å´0 could not be broken down into cylinders. Integrate::region: The region defined by y.89ÅÛz.89ÅÛ1&&x.89 Å´0&&-x+y.89Å´0&&1-z.89Å26 40 could not be broken down into cylinders. Integrate::region: The region defined by -1.89ÅÛz.89ÅÛ-y&&x21 1Å´0&&-x+y.89Å´0 could not be broken down into cylinders. General::stop: Further output of Integrate::region will be suppressed during this calculation. Out[3]= -(-1+y) UnitStep[x,1-y,-x+y] Clearly an attempt was made to decompose this into cylinders with respect to z (using CAD) which of course failed. Fortunately we still get the right answer. Secondly, the package actually contains some interesting functions which have been commented out and were apparently intended for future development. On of them is: removeUnitStep[expr_] := ReplaceRepeated[expr, UnitStep[e__] :> Boole[Apply[And, Map[(# .89Å´ 0) &, {e}]]]]; Using it we get: removeUnitStep[FullSimplify[Integrate[UnitStep[x,y-x,z-y,1- z],{z,0,1}],y>0]] (error messages removed) -(-1+y) Boole[x.89Å´0&&x.89ÅÛy&&y.89[ CapitalARing]Û1] Mathematica can't convert this into (1-y)Boole[0<=x<=y<=1] but it can do the converse: Map[LogicalExpand,(1-y)Boole[0.89ÅÛx.89[Capita lARing]Ûy.89ÅÛ1],{2}] (1-y) Boole[0.89ÅÛx&&x.89ÅÛ y&&y.89ÅÛ1] Andrzej Kozlowski Yokohama, Japan http://www.mimuw.edu.pl/~akoz/ http://platon.c.u-tokyo.ac.jp/andrzej/ > Boole (defined in the AddOn package Calculus`Integration`) is not > written to deal with symbolic parameters. So you may do better to use > better to use the built-in UnitStep function for which Mathematica > knows more rules. In fact, if you do not mind getting an error message > you can get something like your answer by mixing UnitStep and Boole: > > << Calculus`Integration` > > In[2]:= > FullSimplify[Integrate[Boole[0 < x < y < 1]*UnitStep[z - y], > {z, 0, 1}],y>0] > > Integrate::region: The region defined by 0å¡åÂzå¡ åÂ1&&0 could > not be > broken down into cylinders. > > Out[2]= > -(-1+y) Boole[0 > Of course the UnitStep is not necessary since the condition y<1 is > already included in Boole, but the Integration package does not have > rules for combining Bool and UnitStep (don't forget that Boole is not a > built in function!). > > If you dispense with Bool altogether you get: > > In[3]:= > FullSimplify[Integrate[UnitStep[x,y-x,z-y,1-z],{z,0,1}],y>0] > > Out[3]= > -(-1+y) UnitStep[x,1-y,-x+y] > > Note that this expresses exactly the same condition as > (1-y)Boole[0 > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ > > > > > and also try to use proper Mathematica > > >> Suppose f(x,y,z)=Boole[0> over, say, z, i.e. Integrate[f[x,y,z],{z,0,1}]. One would expect to >> see >> the >> output like this (1-y)Boole[0> as an argument in the Boole function). Instead, an error appears >> (warning) that the integration cannot be performed. >> >> How to resolve this issue so it produces a desired answer? >> >> Janusz. >> >> >> >> >> > > > > Reply-To: ==== --- not as a poor a showing for my simple-minded method as I feared. data2 = Table[{Random[Integer, {1, 100}], Random[Real, {0, 5}]}, {20000}]; nmax = 100; data = data2; Timing[dave = Transpose[{Range[nmax], (Plus @@ #1/Length[#1] &) /@ Map[Last, Split[Union[Join[data, Table[{i, 0}, {i, 1, nmax}]]], #1[[1]] == #2[[1]] &], {2}]}];] ClearAll[total, count] total[x_] := 0 count[x_] := 0 Timing[{total@#[[1]] += #[[2]], count[#[[1]]]++} & /@ data; brt = {#, total[#]/count[#]} & /@ Union[data[[All, 1]]]; ] {0.20299999999999985*Second, Null} {0.5619999999999998*Second, Null} DrBob -----Original Message----- Split[%, #1[[1]] == #2[[1]] & ] Map[Last, %, {2}] (Plus @@ #1/Length[#1] & ) /@ % Transpose[{Range[nmax], %}] giving {{1, 0}, {1, 6}, {1, 10}, {2, 0}, {2, 5}, {3, 0}, {3, 1}, {3, 2}, {4, 0}, {4, 2}, {4, 3}, {5, 0}, {5, 2}, {6, 0}, {7, 0}, {7, 1}, {8, 0}, {9, 0}, {10, 0}} {{{1, 0}, {1, 6}, {1, 10}}, {{2, 0}, {2, 5}}, {{3, 0}, {3, 1}, {3, 2}}, {{4, 0}, {4, 2}, {4, 3}}, {{5, 0}, {5, 2}}, {{6, 0}}, {{7, 0}, {7, 1}}, {{8, 0}}, {{9, 0}}, {{10, 0}}} {{0, 6, 10}, {0, 5}, {0, 1, 2}, {0, 2, 3}, {0, 2}, {0}, {0, 1}, {0}, {0}, {0}} {16/3, 5/2, 1, 5/3, 1, 0, 1/2, 0, 0, 0} {{1, 16/3}, {2, 5/2}, {3, 1}, {4, 5/3}, {5, 1}, {6, 0}, {7, 1/2}, {8, 0}, {9, 0}, {10, 0}} This wraps it into one statement. nmax = 10; Transpose[{Range[nmax], (Plus @@ #1/Length[#1] & ) /@ Map[Last, Split[Union[Join[data, Table[{i, 0}, {i, 1, nmax}]]], #1[[1]] == #2[[1]] & ], {2}]}] {{1, 16/3}, {2, 5/2}, {3, 1}, {4, 5/3}, {5, 1}, {6, 0}, {7, 1/2}, {8, 0}, {9, 0}, {10, 0}} This times a case of 20000 pairs on an 800MHz machine. data2 = Table[{Random[Integer, {1, 100}], Random[Real, {0, 5}]}, {20000}]; nmax = 100; data = data2; Timing[Transpose[{Range[nmax], (Plus @@ #1/Length[#1] & ) /@ Map[Last, Split[Union[Join[data, Table[{i, 0}, {i, 1, nmax}]]], #1[[1]] == #2[[1]] & ], {2}]}]; ] {0.55 Second, Null} David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ For the example, i want to report: output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} In this example, x=6 does not occur so i report the average y[6] = 0. Can anyone suggest a way to do this efficiently?/ many thanks dave +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ David E. Burmaster, Ph.D. Alceon Corporation POBox 382069 (new Box number effective 1 Sep 2001) Harvard Square Station Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) Voice 617-864-4300 Web http://www.Alceon.com +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ==== >-----Original Message----- >Sent: Wednesday, October 16, 2002 8:26 PM >To: mathgroup@smc.vnet.net > > >Greetings > >This problem can be solved by conventional programming, but I >wonder if >there is an elegant Mathematica solution ? > >A list contains pairs of values, with each pair representing >the lower and >upper edge of a sub-range. Some of the sub-ranges partially >overlap, some >fully overlap, others don't overlap at all. The problem is to >produce a >second list that contains the overall upper and lower edges of the >overlapping sub-ranges. > >A simple example : {{100,200},{150,250},{120,270},{300,400}} >would result >in {{100,270},{300,400}}. > >In the real case, the input list has several hundred elements and the >output list typically has five elements. > >I have a working solution based on loops, but there must be a >more elegant >one. I would be very grateful for any suggestions. > > > >John Leary > > John, several proposals (without any attempt to moduralize): (1) use IntervalUnion: List @@ IntervalUnion @@ Interval /@ list (2) use Split (it's a little bit tricky to be correct): high = Sequence[]; {#[[1, 1]], Max[#[[All, -1]]]} & /@ Split[Sort[list], (high = Max[high,Last[#1]]) >= First[#2] || (high = Last[#1])&] (3) procedural programming: maxExtends[list_] := (sl = Sort[list]; length = Length[sl]; r = collect[]; i = 1; While[i <= length, {low, high} = sl[[i]]; If[++i <= length, {curlow, curhigh} = sl[[i]]; While[high >= curlow && (high = Max[high, curhigh]; ++i <= length), {curlow, curhigh} = sl[[i]] ]]; r = collect[r, {low, high}] ]; List @@ Flatten[r]) Let's do some benchmarks: 10,000 Intervals: list = {# - Random[], # + Random[]} & /@ NestList[# + Random[] &, 0, 10000]; List @@ IntervalUnion @@ Interval /@ list // Length // Timing {2.503 Second, 1181} high = Sequence[]; {#[[1, 1]], Max[#[[All, -1]]]} & /@ Split[Sort[ list], (high = Max[high, Last[#1]]) >= First[#2] || (high = Last[#1]) &] // Length // Timing {2.934 Second, 1181} maxExtends[list] // Length // Timing {3.926 Second, 1181} The corresponding results for 100,000 Intervals: {27.329 Second, 11266} {30.234 Second, 11266} {35.791 Second, 11266} and for 500,000 Intervals {144.058 Second, 56728} {154.782 Second, 56728} {181.111 Second, 56728} To look at scaling behaviour I just collected the prior results IntervalUnion: {%355, %345 , %350}[[All, 1, 1]] {2.503, 27.329, 144.058} % // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} & {1.09185, 1.05425} Split: {%357, %347, %352}[[All, 1, 1]] {2.934, 30.234, 154.782} % // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} & {1.03047, 1.02389} Procedural: {%358, %348, %353}[[All, 1, 1]] {3.926, 35.791, 181.111} % // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} & {0.91164, 1.01205} Due to Sort, the Split and the Procedural versions should behave as O[n log n], I'm not shure whether IntervalUnion does (seems to be a little bit more progressive at costs). -- Hartmut Wolf ==== I use NDSolve to approximate a 6-dimensional and highly non-linear dynamic system numerically. QUESTION: What are usual (and simple) techniques to check the reliability of the resulting numerical solution? So far I tried to use another solution algorithm by switching the Option Method from Method->Automatic to Method->RungeKutta. Apart from numerical differences, the solution qualitatively remained unaffected (I am mainly interested in the qualitative characteristics of the solution). I would be grateful for any hint! ==== Here is a version which compresses the list going forward, it does not seem to be significantly faster than the other version but the memory use should be slightly smaller: (*Handle some degenerate cases here *) fcompress[{}]:={}; (*This pattern is the stopping point of the recursion*) fcompress[lst:{{_?NumericQ,_?NumericQ}}]:=lst (*This function needs to be called with a sorted list*) fcompress[lst:{{_?NumericQ,_?NumericQ}..}]:=With[{rng1=lst[[1]],rng2=lst [[2]]},If[rng1[[2]] > > lst = {{100, 200}, {150, 250}, {120, 270}, {300, 400}}; > > List @@ Union @@ Interval /@ lst > > {{100, 270}, {300, 400}} > > List @@ Interval[Sequence @@ lst] > > {{100, 270}, {300, 400}} > Forgot about the Interval function, but to continue the pattern List@@Interval@@lst also works. I personally prefer not to use Sequence objects if I can avoid them. Sseziwa PS - It is much faster than my previous posts. ==== Dear group, very clear. Suppose that I have a list of points {p1,p2, ..., pn}, I try to find all possible pairs of them. The pairs may include {pi,pi}, but {pi,pj} and {pj,pi} are considered the same and only one is counted. That said. After some try and error, I came to the following way: h=4;w=5; points=Flatten[Outer[List,Range[w],Range[h]],1]; pairs=Flatten[Map[Outer[List,{#},Drop[points,Position[points,#][[1,1]]-1],1][ [1]]&,points],1]; The speed of the above calculation is reasonably fast. But I run into the memory problem. For example, for h=64 and w=64, the length of the list pairs will be w*h (w*h+1)/2 = 8,390,656. In my case, The numbers for h and w will be a lot larger than 64. How can I get around this memory problem or that's the dead end for my calculation (I do have 1 GB physical mem in Cheng >Dear group, > > I have the following question regarding a lengthy calculation >using Mathematica: > >For given w points in x direction and h points in y direction, I can >construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > >Next, I need to find all the possible pairs of point including points >themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > >Then, I have to clear those pairs that repeat themselves, i.e., pair AB and >pair BA. Also, when w and h are of the order of 1000s, the computation >takes a very long time. Is there a better way of doing the second part of > >Sincerely > >Cheng > > >==================================================== >Cheng Liu, Ph.D. >MST-8, Structure/Property Relations >Materials Science and Technology Division >Los Alamos National Laboratory >Los Alamos, New Mexico 87545 > >==================================================== ==================================================== Cheng Liu, Ph.D. MST-8, Structure/Property Relations Materials Science and Technology Division Los Alamos National Laboratory Los Alamos, New Mexico 87545 ==================================================== ==== Just two small (maybe relevant) notes: ----- Original Message ----- even some more than just today's machine precision. > Sorry, but that's not as profound as it sounds. The speed of light is > indeed a very specific number, but that doesn't mean we can measure it > precisely. Instead, like E or Pi or 2 or Sqrt[7], it's a defined > constant and -- unlike E or Pi or Sqrt[7] -- the definition doesn't > allow us to compute it with arbitrary precision. Yes, it's defined now > so that it can pretend to unlimited precision -- but that only means > meters (or seconds, take your pick) aren't defined precisely. The speed of light is *postulated* (rather then defined) constant, and (since 1983.) in the international metric (aka SI) system of units one meter is *defined* to be the distance traveled by light during (exactely) 1 / 299792458 seconds (second is defined some other way). So it follows that the (exact) value for the speed of light is 299792458 m / s. However, the problem is not in the correctness of this particular value (it is actually just a convinient convention), but in the postulate that this value is the same for all observers. To be specific, if there are two observers moving relative to eachother and measuring the speed of light using two (in principle) _identical_ experimental devices, the question is whether they get the same result, ie. c' = c. Experimentally speaking, one wihses to know how much (if at all) the quantity (c'-c)/c differs from zero. If someone measures a nonzero value, that _would_ actually be for a Nobel... Marko > -----Original Message----- > To: mathgroup@smc.vnet.net > > > In the real world of physics there are several subatomic level > processes > which can only be distinguished by small changes in the n-th decimal > place. > But there is one example which is fairly easy to comprehend, and that is > the > constancy of the speed of light in a vacuum regardless of reference > frame, > as proposed in Einstein's special theory of relativity. If this were > true > only to the 9th or 10th decimal place, or, for that matter, to the > 50th > place, then whoever managed to show that it was not really a constant > would > certainly be in Nobel Prize territory, and much of modern physics would > need > a rewrite. > > Kevin > > Greetings, > > I have read with great interest this lively debate on numerical > prcesion > and > accuracy. As I work in the fields of finance and economics, where we > feel > ourselves blessed if we get three digits of accuracy, I'm curious as > to > what > scientific endeavors require 50+ digits of precision? As I recall > there > are > some areas, such as high energy physics and some elements of > astronomy, > that > might require so many digits in some circumstances. Are there > others? > > > -Mark > > > > > Reply-To: ==== Sorry, but that's not as profound as it sounds. The speed of light is indeed a very specific number, but that doesn't mean we can measure it precisely. Instead, like E or Pi or 2 or Sqrt[7], it's a defined constant and -- unlike E or Pi or Sqrt[7] -- the definition doesn't allow us to compute it with arbitrary precision. Yes, it's defined now so that it can pretend to unlimited precision -- but that only means meters (or seconds, take your pick) aren't defined precisely. For anything we can measure (or even COUNT, in the real world), I suspect 16-digit machine precision is more than enough. Bobby -----Original Message----- as proposed in Einstein's special theory of relativity. If this were true only to the 9th or 10th decimal place, or, for that matter, to the 50th place, then whoever managed to show that it was not really a constant would certainly be in Nobel Prize territory, and much of modern physics would need a rewrite. Kevin > Greetings, > > I have read with great interest this lively debate on numerical prcesion > and > accuracy. As I work in the fields of finance and economics, where we feel > ourselves blessed if we get three digits of accuracy, I'm curious as to > what > scientific endeavors require 50+ digits of precision? As I recall there > are > some areas, such as high energy physics and some elements of astronomy, > that > might require so many digits in some circumstances. Are there others? > > > -Mark ==== I have 2 or more separate Plots which have different y but the same x axes. Like: Plot[Sin[x],{x,0,10}]; Plot[1000Sin[x],{x,0,10}]; At the display and printout, the y axes are not aligned. Even using the PlotRegion and ImageSize Options doesn't help. The only way I found was to align it manually with the mouse. Is there a package that solves the problem? The problem is, I have many, many plots to align... I use Mathematica 4.0.2.0 on a Windows 2000 PC. Who can help? Max ==== I have 2 or more separate Plots which have different y but the same x axes. Like: Plot[Sin[x],{x,0,10}]; Plot[1000Sin[x],{x,0,10}]; At the display and printout, the y axes are not aligned. Even using the PlotRegion and ImageSize Options doesn't help. The only way I found was to align it manually with the mouse. Is there a package that solves the problem? The problem is, I have many, many plots to align... I use Mathematica 4.0.2.0 on a Windows 2000 PC. Who can help? Max Answers please to: ulbrich@biochem.mpg.de ==== > A simple example : {{100,200},{150,250},{120,270},{300,400}} would result > in {{100,270},{300,400}}. > > In the real case, the input list has several hundred elements and the > output list typically has five elements. > > I have a working solution based on loops, but there must be a more elegant > one. I would be very grateful for any suggestions. Until recently, this could have been tedious, but now, tada!: In[31] := data = {{100, 200}, {150, 250}, {120, 270}, {300, 400}}; List @@ IntervalUnion @@ Interval /@ data Out[31] = {{100, 270}, {300, 400}} Tom Burton ==== >-----Original Message----- >Sent: Wednesday, October 16, 2002 8:26 PM >To: mathgroup@smc.vnet.net > > >Dear Fellows in MathGroup, > >I have a list of 17,000+ {x,y} pairs of data > > each x value is a positive integer from 1 to 100+ > > each y value is a positive real number > >As a *short* example, let's consider: > > data = {{3,1},{4,3},{3,2},{1,10},{4,2},{1,6},{5,2},{2,5},{7,1}} > >I want to group the data by the x value and report the >arithmetic average >of the y values in each group. > >For the example, i want to report: > > output = {{1,8},{2,5},{3,1.5},{4,2.5},{5,2},{6,0},{7,1}} > >In this example, x=6 does not occur so i report the average y[6] = 0. > >Can anyone suggest a way to do this efficiently?/ > >many thanks >dave > > > >+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ >David E. Burmaster, Ph.D. >Alceon Corporation >POBox 382069 (new Box number effective 1 Sep 2001) >Harvard Square Station >Cambridge, MA 02238-2069 (new ZIP code effective 1 Sep 2001) > >Voice 617-864-4300 > >Web http://www.Alceon.com >+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ > > > > Dave, my first attempt used the same reasoning as Daniel Lichtblau proposed (and came out only slightly faster than his). However the Sort/Split idea as brought forward by Bob Hanlon and Allan Hayes is much faster; Bobby Treat's version turns out to be slower (than Daniel's and mine). To reach comparable results, I slightly modified Allan's solution (which was fastest): data = Table[{Random[Integer, {1, 98}], Random[]}, {20000}]; (f[x_] = 0; ((f[#1[[1, 1]]] = Plus @@ #1[[All, 2]]/Length[#1]) &) /@ Split[Sort[data], #1[[1]] == #2[[1]] &]; r4 = {#, f[#]} & /@ Range[98];) // Timing {3.045 Second, Null} So I reconsidered that idea and found a solution which is nearly twice as fast: binnedAverage2[data_, max_] := Module[{v, i, ix, ixx, ixxx}, {i, v} = With[{rr = Range[max]}, Transpose[Sort[Join[data, Transpose[{rr, rr - rr}]]]]]; ix = Split[i]; ixx = FoldList[Plus[#1, Length[#2]] &, 0, ix]; ixxx = Transpose[Transpose[Partition[ixx, 2, 1]] + {1, 0}]; Transpose[{First /@ ix, Plus @@ #/Max[Length[#] - 1, 1] &[Take[v, #]] & /@ ixxx}]] (r7 = binnedAverage2[data, 98]); // Timing {1.612 Second, Null} r7 == r4 True -- Hartmut Wolf ==== greetings: can someone suggest a method for capturing what is printed via ?Global`* to a list? also i would like ?@ in a list. michael ==== check out the Names function. --- / FROM iMic AT 02.10.18 09:39 (Yesterday) / --- > greetings: > > can someone suggest a method for capturing what is printed > via ?Global`* to a list? also i would like ?@ in a list. > > michael -- Daniel Reeves -- http://ai.eecs.umich.edu/people/dreeves/ You know, it's at times like this when I'm trapped in a Vogon airlock with a man from Betelgeuse and about to die of asphyxiation in deep space that I really wish I'd listened to what my mother told me when I was young! Why, what did she tell you? I don't know, I didn't listen! ==== I need to color the surface of a regular polyhedron (an icosahedron, specifically) according to a relatively simple function of the spatial coordinates of the surface. I easily got a nice icosahedron of the appropriate size, but thus far I have been unable to resolve the coloring issue. Any advice is appreciated. Francis ==== >can someone suggest a method for capturing what is printed >via ?Global`* to a list? also i would like ?@ in a list. > Names[Global`*] Names[@] Bob Hanlon ==== > Dear group, > > I have the following question regarding a lengthy calculation > using Mathematica: > > For given w points in x direction and h points in y direction, I can > construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > > Next, I need to find all the possible pairs of point including points > themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > > Then, I have to clear those pairs that repeat themselves, i.e., pair > AB and > pair BA. Also, when w and h are of the order of 1000s, the computation > takes a very long time. Is there a better way of doing the second > part of > > Have you tried using the KSubsets function from DiscreteMath`Combinatorica`? What you want are all KSubsets of length 2 plus the original set of points duplicated for example: Needs[DiscreteMath`Combinatorica`] pairs=Join[KSubsets[points,2],Transpose[{points,points}]] Sseziwa ==== Dear All, I am currently beginning to use the 4.2 version of Mathematica on winNT. I find that the front end is very crash prone (a lot more then 4.1)... it often crashes on editing things. I am wondering if anyone experienced the same problems and if any solution had already been found. -- ________________________________________________________ Dr. Nicolas Fressengeas - - - http://www.ese-metz.fr/~fresseng Sup.8elec / Laboratoire Mat.8eriaux Optiques, Photonique et Syst.8fmes 2 rue E.Belin, 57070 METZ Cedex Plan d'acc.8fs: http://www.iti.fr/PlanPerso/23704/1 When everything else fails, read the instructions... ==== I would like to replace Dt[x_] in a complex expression. For example consider Dt[x]/.Dt[arg_]->f[arg] where x is a pure Symbol (has no value). However, Mathematica refuses apply the rule. Various other attempts, for example Unevaluted[Dt[arg_]]:>f[arg] and HoldForm[...] were unsuccessful. I managed to circumvent the problem by Dt[x]/.Dt->fun However, I were more happy if I understood why the first attempt was not successful. Can someone explain? Johannes Ludsteck <><><><><><><><><><><><> Johannes Ludsteck Economics Department University of Regensburg Universitaetsstrasse 31 93053 Regensburg ==== students from south america. Due to our final work, certain coupled non-linear ODE systems have appear, and we don't have any idea about how to resolve it, in spite we attempt to. For our purposes, we would need analytical solutions -if there exist- for the following systems, dx/dt = ax^2 + by^2 dx/dt = cx^2 dx/dt = axy + by^2 dy/dt = cxy + dx^2 Where a, b, c and d are known constants paremeters of the problem. We would be very grateful if you can help us with this matter. We were able to fit numerically the solutions for both systems, in a relatively wide range of values, but we did not find anything aboout the analytical solutions for none of the systems. In brief words, for our work we would need the explicit expressions for x(t) and y(t), if they are known, of course. If you can help us, please contact us at, estudfis@yahoo.com.au We are very grateful, since this moment. Sincerely, Javier Krshpa S.87nchez and H.8ector Rivera Firpo Montevideo,Uruguay. http://careers.yahoo.com.au - Yahoo! Careers - 1,000's of jobs waiting online for you! ==== I'm not altogether sure I understood your problem, but it seems to me that if In[1]:= lay={{{ob11},{ob12},{ob13},{ob14}},{{ob21},{ob22},{ob23},{ob24}}}; then In[2]:= Flatten[lay,1] Out[2]= {{ob11},{ob12},{ob13},{ob14},{ob21},{ob22},{ob23},{ob24}} gets rid of the intermediate layer. Alternatively, List/@Flatten[lay]. Tomas Garza Mexico City ----- Original Message ----- > > f[gg] gives {{{ob11}, {ob12}, {ob13}},{{ob21}, {ob22}, {ob23}, {ob24}}, ... > ,{{obn1}, {obn2}, {obn3}}} > > where the number of objects in each layer can vary. > > The additional intermediate layer in the output of f prevents the feedback > to f, when use function like nest. > > I looked up and tried several method, and it seems to be easy to get rid of > all inner layers, or the innerest layer, or the outmost layer (use > Sequence). > > Is there a way to get rid of the middle layer as describe above? > > > Sincerely, > JT > > > > > _________________________________________________________________ > Surf the Web without missing calls! Get MSN Broadband. > http://resourcecenter.msn.com/access/plans/freeactivation.asp > > > ==== gg={{ob1},{ob2},{ob3}}; However, the output of f having a form like: f[gg] gives {{{ob11}, {ob12}, {ob13}},{{ob21}, {ob22}, {ob23}, {ob24}}, ... ,{{obn1}, {obn2}, {obn3}}} where the number of objects in each layer can vary. The additional intermediate layer in the output of f prevents the feedback to f, when use function like nest. I looked up and tried several method, and it seems to be easy to get rid of all inner layers, or the innerest layer, or the outmost layer (use Sequence). Is there a way to get rid of the middle layer as describe above? Sincerely, JT _________________________________________________________________ Surf the Web without missing calls!ÊGet MSN Broadband. http://resourcecenter.msn.com/access/plans/freeactivation.asp ==== > I use NDSolve to approximate a 6-dimensional and highly non-linear > dynamic system numerically. > > QUESTION: What are usual (and simple) techniques to check the > reliability of the resulting numerical solution? I would check the the boundary conditions and then plot the residual error from the differential equation. Here is an example with all output deleted. possibilities = NDSolve[{y[x]^4 + y'[x]^3 == 0, y[0] - 1 == 0}, y[x], {x, 0, 1}] yy[x_] = y[x] /. possibilities SHOW RESULTS Needs[Graphics`Colors`]; SetOptions[Plot, PlotStyle -> ({Thickness[0.01], #1} & ) /@ {Red,Green,Blue} ]; Plot[Evaluate[Re[yy[x]]], {x, 0, 1}] Plot[Evaluate[Im[yy[x]]], {x, 0, 1}] CHECK INITIAL CONDITIONS yy[0] - 1 PREPARE AND SHOW RESIDUAL res[x_] = yy[x]^4 + yy'[x]^3 Plot[Evaluate[Re[res[x]]], {x, 0, 1}] Plot[Evaluate[Im[res[x]]], {x, 0, 1}] Plot[Evaluate[Re[res[x]]], {x, 0, 0.001}, PlotRange -> All] Plot[Evaluate[Im[res[x]]], {x, 0, 0.001}, PlotRange -> All] ==== I apologize for the length of this post, but I don't see how else to be precise about my question. The short story is this: -- copy and paste the lines below into Mathematica -- execute -- the result is a really big expresssion, but I want the terms in this expression to be grouped in powers of my variable b. However, Collect[] doesn't appear to be working right. I call Collect[%, b] and I think I'm getting % back. At the very least, I can clearly see more than one term in the expression that includes b^9, for example. I'd be very grateful if someone a little more knowledgeable than I could execute these lines and see if they can get Collect[] to work. Of, if this is how Collect[] is supposed to work, what command should I be using? Troy. So, here's what I did. First, to get my equation: denom = Sqrt[(B^2 - r^2)^2 + 4*(r^2)*(b^2)] cnu = (2*b^2 - B^2 + r^2)/denom snu = -2*b*Sqrt[B^2 - b^2]/denom sif = 2*r*b/denom cif = (r^2 - B^2)/denom pdr = -Cos[ds]*Sin[q]*(snu*cif + cnu*sif) - Sin[ds]*(cnu*cif - snu*sif) HH = -(B^2 - b^2)*V^2/(r^2) + (((B*V)^2)/( r^2) - 2*w*b*V*Cos[q]*Cos[ds] + (w* r)^2 - (w*r*pdr)^2)*(Cos[qr])^2 Now, my equation is really HH == 0, but there's some manipulations I want to do first. I don't know Mathematica well, so all I could see to do was to perform operations on HH, then put the equation together. H2 = Expand[HH] H3 = Collect[HH, Sqrt[B^2 - b^2]] H4 = H3*( (4 * (b*r)^2 + (B^2 - r^2)^2)^2 ) H7 = H4*(r^2) H8 = Collect[ Cancel[H7], Sqrt[-b^2 + B^2] ] H9 = Equal[H8, 0] /. Equal[ aa_ + Sqrt[B^2 - b^2]*bb_, 0] -> Equal[ Sqrt[B^2 - b^2]*bb, -aa] H10 = Thread[#^2 &[H9], Equal] // ExpandAll H11 = H10 /. Equal[ mm_ , nn_] -> Equal[ mm - nn , 0] H12 = H10 /. Equal[ qq_ , 0] -> qq For H3 and H8, Collect[] seems to work. The command to get H10 I copied from a post by Andrzej Kozlowski. H13 = Collect[H11,b] H14 = Collect[H12,b] but the results don't seem to be 'collected' polynomials. ==== Max: Your problem is due to the necessary space to the left of the y-axis to locate the ticks. Try, for example, eliminating the y-ticks: Plot[Sin[x], {x, 0, 10}, Ticks -> {Automatic, None}]; Plot[1000Sin[x], {x, 0, 10}, Ticks -> {Automatic, None}]; With an additional space in the x-range, it is possible to accommodate the y-ticks for both graphs keeping the alignment. Plot[Sin[x], {x, 0, 10}, PlotRange -> {{-1.5, 10}, Automatic}]; Plot[1000Sin[x], {x, 0, 10}, PlotRange -> {{-1.5, 10}, Automatic}]; Greetings Germ.87n Buitrago A. ----- Original Message ----- > > > At the display and printout, the y axes are not aligned. Even using the > PlotRegion and ImageSize Options doesn't help. The only way I found > was to align it manually with the mouse. > Is there a package that solves the problem? > The problem is, I have many, many plots to align... > I use Mathematica 4.0.2.0 on a Windows 2000 PC. > Who can help? > > Max > > Answers please to: > > ulbrich@biochem.mpg.de > > ==== The position of the plot in the cell is determined by option ImageMargins, and you may check that it is the same for both plots. But the plot includes the ticks along the axes, so the reason why the vertical axes are not aligned is that the ticks along them have different lengths, and this causes the position of each axis to move left or right, according to what is needed to include the ticks. You may check this by using the option Ticks->None in both plots. You'll see that the axes are now aligned. One possibility is to have the space assigned to the vertical ticks to be the same in both plots, and this may be achieved by using strings of the same length for the ticks, instead of letting them be automatically assigned. Try the following: In[1]:= Plot[Sin[x], {x, 0, 10}, Ticks -> {Automatic, {{-1, -1}, {-0.5, -0.5}, {0, 0}, {0.5, 0.5}, {1, 1}}}]; Plot[1000*Sin[x], {x, 0, 10}, Ticks -> {Automatic, {{-1000, 1000}, {-500, -500}, {0, 0}, {500, 500}, {1000, 1000}}}]; Here I left 5 positions as the maximum string length in both cases, corresponding to -0.5 and -1000, respectively. The vertical axes are now aligned. BTW, it is a relatively simple matter to construct the ticks without having to type a lot of stuff. Suppose t is the list of ticks you would like to have along the vertical axis, e.g.: In[2]:= t = Table[1000*j, {j, -1, 1, 0.25}]; In[3]:= tks = Transpose[{t, ToString /@ Round[t]}]; Then try In[4]:= Plot[Sin[x], {x, 0, 10}, Ticks -> {Automatic, {{-1, -1}, {-0.5, -0.5}, {0, 0}, {0.5, 0.5}, {1, 1}}}]; Plot[1000*Sin[x], {x, 0, 10}, Ticks -> {Automatic, tks}]; and you'll get an even nicer output. Tomas Garza Mexico City ----- Original Message ----- > > > At the display and printout, the y axes are not aligned. Even using the > PlotRegion and ImageSize Options doesn't help. The only way I found > was to align it manually with the mouse. > Is there a package that solves the problem? > The problem is, I have many, many plots to align... > I use Mathematica 4.0.2.0 on a Windows 2000 PC. > Who can help? > > Max > > Answers please to: > > ulbrich@biochem.mpg.de > > > ==== >I have 2 or more separate Plots which have different y but the same x >axes. >Like: > >Plot[Sin[x],{x,0,10}]; >Plot[1000Sin[x],{x,0,10}]; > > >At the display and printout, the y axes are not aligned. Even using the >PlotRegion and ImageSize Options doesn't help. The only way I found >was to align it manually with the mouse. >Is there a package that solves the problem? >The problem is, I have many, many plots to align... >I use Mathematica 4.0.2.0 on a Windows 2000 PC. > Pad each axis label with a string of blanks that makes both axes labels take up the same space. showplot[plt_] := Show[plt, Ticks -> {Automatic, Prepend[(Ticks /. AbsoluteOptions[plt])[[2]], {0.001, StringJoin[Table[ , {5}]]}]}, DisplayFunction -> $DisplayFunction] p1 = Plot[Sin[x], {x, 0, 10}, DisplayFunction -> Identity]; p2 = Plot[1000Sin[x], {x, 0, 10}, DisplayFunction -> Identity]; showplot[p1]; showplot[p2]; Bob Hanlon Reply-To: ==== Why make a list of them at all? That is, you know what the pairs are without listing them, and you can form any pair you want without listing them. So -- why spend all that memory, even if you have it? (And you don't.) I just see no reason for it. Bobby -----Original Message----- h=4;w=5; points=Flatten[Outer[List,Range[w],Range[h]],1]; pairs=Flatten[Map[Outer[List,{#},Drop[points,Position[points,#][[1,1]]-1 ],1][[1]]&,points],1]; The speed of the above calculation is reasonably fast. But I run into the memory problem. For example, for h=64 and w=64, the length of the list pairs will be w*h (w*h+1)/2 = 8,390,656. In my case, The numbers for h and w will be a lot larger than 64. How can I get around this memory problem or that's the dead end for my calculation (I do have 1 GB physical mem in Cheng >Dear group, > > I have the following question regarding a lengthy calculation >using Mathematica: > >For given w points in x direction and h points in y direction, I can >construct all the points using > > h=10; w=8; > points=Flatten[Transpose[Outer[List,Range[w],Range[h]]],1] > >Next, I need to find all the possible pairs of point including points >themselves, i.e., pair AA. I can use > > pairs=Outer[List,points,points,1] > >Then, I have to clear those pairs that repeat themselves, i.e., pair AB and >pair BA. Also, when w and h are of the order of 1000s, the computation >takes a very long time. Is there a better way of doing the second part of > >Sincerely > >Cheng > > >==================================================== >Cheng Liu, Ph.D. >MST-8, Structure/Property Relations >Materials Science and Technology Division >Los Alamos National Laboratory >Los Alamos, New Mexico 87545 > >==================================================== ==================================================== Cheng Liu, Ph.D. MST-8, Structure/Property Relations Materials Science and Technology Division Los Alamos National Laboratory Los Alamos, New Mexico 87545 ==================================================== ==== How do you remove the In[] and Out[] lines so they don't appear when you print? Brian (averso@yahoo.com) ==== I reported this to Wolfram Research, but have had no confirmation yet. Have others observed that there are problems displaying the headers in some of the help notebooks? Here's a demonstration of the problem: http://baldur.globalsymmetry.com/proprietary/com/wri/ch05.html#id3186296 I originally took this to be a font related issue, but I'm not sure anymore where the problem originates. The code for the notebooks is still a bit beyond my depth of understanding of Mathematica. I'm thinking about switching all Helvetica instances to Primasans which I got from WordPerfect. My understanding of how fonts work is fairly limited, though I've learned a great deal from investigating the origins of this problem I really believe there is a minor bug in the ToFileName[{$TopDirectory, SystemFiles, StyleSheets}, HelpBrowser.nb]. Any observations on this? -- Hatton's Law: There is only One inviolable Law. Reply-To: ==== Wolf, I timed your methods plus my own entry in the contest, for 500,000 elements: list = {# - Random[], # + Random[]} & /@ NestList[# + Random[] &, 0, 500000]; List @@ IntervalUnion @@ Interval /@ list // Length // Timing high = Sequence[]; {#[[1, 1]], Max[#[[All, -1]]]} & /@ Split[ Sort[list], (high = Max[high, Last[#1]]) ? First[#2] || (high = Last[#1]) &] // Length // Timing maxExtends[list_] := (sl = Sort[list]; length = Length[sl]; r = collect[]; i = 1; While[i ? length, {low, high} = sl[[i]]; If[++i ? length, {curlow, curhigh} = sl[[i]]; While[high ? curlow && (high = Max[ high, curhigh]; ++i ? length), {curlow, curhigh} = sl[[i]]]]; r = collect[r, {low, high}]]; List @@ Flatten[r]) maxExtends[list] // Length // Timing Timing[Length@(List @@ Interval @@ list)] (* <======= mine, Dave Park's, Carl Woll's, Mark Westwood's *) {8.625*Second, 57021} {7.75*Second, 57021} {8.202999999999989*Second, 57021} {6.578000000000003*Second, 57021} and here's a second trial, after more memory has been tied up: {9.5*Second, 56841} {8.202999999999975*Second, 56841} {8.875*Second, 56841} {7.125*Second, 56841} I'm a little surprised the built-in method wins so narrowly. Here's Daitaro's method: Timing[data = Sort[list, #[[1]] < #2[[1]] &];Length[{{data[[1, 1]], Fold[If[# < #2[[1]], #, Max[#, #2[[2]]]] &, data[[1, 2]], Rest[data]]}, {Fold[If[# > #2[[2]], #, Min[#, #2[[1]]]] &, ( data = Reverse@data)[[1, 1]], Rest[data]], data[[1, 2]]}}]] {26.359 Second, 2} It always returns two intervals. Bobby Treat -----Original Message----- > >This problem can be solved by conventional programming, but I >wonder if >there is an elegant Mathematica solution ? > >A list contains pairs of values, with each pair representing >the lower and >upper edge of a sub-range. Some of the sub-ranges partially >overlap, some >fully overlap, others don't overlap at all. The problem is to >produce a >second list that contains the overall upper and lower edges of the >overlapping sub-ranges. > >A simple example : {{100,200},{150,250},{120,270},{300,400}} >would result >in {{100,270},{300,400}}. > >In the real case, the input list has several hundred elements and the >output list typically has five elements. > >I have a working solution based on loops, but there must be a >more elegant >one. I would be very grateful for any suggestions. > > > >John Leary > > John, several proposals (without any attempt to moduralize): (1) use IntervalUnion: List @@ IntervalUnion @@ Interval /@ list (2) use Split (it's a little bit tricky to be correct): high = Sequence[]; {#[[1, 1]], Max[#[[All, -1]]]} & /@ Split[Sort[list], (high = Max[high,Last[#1]]) >= First[#2] || (high = Last[#1])&] (3) procedural programming: maxExtends[list_] := (sl = Sort[list]; length = Length[sl]; r = collect[]; i = 1; While[i <= length, {low, high} = sl[[i]]; If[++i <= length, {curlow, curhigh} = sl[[i]]; While[high >= curlow && (high = Max[high, curhigh]; ++i <= length), {curlow, curhigh} = sl[[i]] ]]; r = collect[r, {low, high}] ]; List @@ Flatten[r]) Let's do some benchmarks: 10,000 Intervals: list = {# - Random[], # + Random[]} & /@ NestList[# + Random[] &, 0, 10000]; List @@ IntervalUnion @@ Interval /@ list // Length // Timing {2.503 Second, 1181} high = Sequence[]; {#[[1, 1]], Max[#[[All, -1]]]} & /@ Split[Sort[ list], (high = Max[high, Last[#1]]) >= First[#2] || (high = Last[#1]) &] // Length // Timing {2.934 Second, 1181} maxExtends[list] // Length // Timing {3.926 Second, 1181} The corresponding results for 100,000 Intervals: {27.329 Second, 11266} {30.234 Second, 11266} {35.791 Second, 11266} and for 500,000 Intervals {144.058 Second, 56728} {154.782 Second, 56728} {181.111 Second, 56728} To look at scaling behaviour I just collected the prior results IntervalUnion: {%355, %345 , %350}[[All, 1, 1]] {2.503, 27.329, 144.058} % // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} & {1.09185, 1.05425} Split: {%357, %347, %352}[[All, 1, 1]] {2.934, 30.234, 154.782} % // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} & {1.03047, 1.02389} Procedural: {%358, %348, %353}[[All, 1, 1]] {3.926, 35.791, 181.111} % // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} & {0.91164, 1.01205} Due to Sort, the Split and the Procedural versions should behave as O[n log n], I'm not shure whether IntervalUnion does (seems to be a little bit more progressive at costs). -- Hartmut Wolf ==== Do you have some package that helps me vizualize subj. when i start from __________________________________________________________________ ckkm __________________________________________________________________ ==== Dear MathGroup, I would like to raise the graphics generated by a contour plot to 3D. But there is a problem. Here is a simple example. Here I make a simple contour plot. I then have two cases of converting the graphics to 3D. In the first case I just keep the surface in the xy-plane, simply adding a 0 z coordinate. In the second case I do a simple affine transformation. In both cases some of the contour regions are improperly rendered. Notice that the ContourGraphics has to be first converted to Graphics. cplot = ContourPlot[x y, {x, -3, 3}, {y, -3, 3}, ColorFunction -> Hue]; cgraphics3d = First[Graphics[cplot]] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0}; cgraphics3d = First[Graphics[cplot]] /. {x_?NumericQ, y_?NumericQ} -> {2x + y, -x + 2y, -1.5x + y}; Show[Graphics3D[ {cgraphics3d}, Lighting -> False, ImageSize -> 450]]; The reason that this problem occurs is that Mathematica does not draw nonintersecting Polygons for each region, but instead will overlay smaller regions on top of larger regions. If we look at the Polygons that ContourPlot produces, after being converted to Graphics, we see that each one goes to a corner of plot domain. Cases[First[Graphics[cplot]], _Polygon, Infinity] The result is that when the graphics are converted to 3D, with slight numerical errors, perhaps in the rendering, some of the Polygons can interlace and produce an incorrect plot. Is there any remedy for this problem? David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ ==== I don't know how much there is to be documented, but I vaguely recall there being a few trick such as a way to execute the last command with a key combination. I've looked around the documentation, but didn't find much. Is there any such documentation? Where? -- Hatton's Law: There is only One inviolable Law. ==== MathGroup, This provides additional information and examples for my earlier posting. I am trying to use ContourPlot to generate colored planar Polygons representing contour regions, and then map them into 3D planar Polygons. There are two problems. 1) The output from converting ContourGraphics to Graphics is not separate polygons for each contour region, but a series of overlapping polygons. Mathematica takes advantage of the fact that in 2D you can lay one Polygon on top of another. But when we convert the Polygons to 3D objects, Mathematica has difficulties. Laying one polygon over another in 3D generally confuses Mathematica's rendering, and perhaps is a difficult 3D problem in general. There is a solution. We can just separate the Polygons into layers with separations just large enough to unconfuse the rendering. As long as we only look at the top side, this works. I illustrate a case below. 2) Mathematica does not correctly render planar polygons that have a concave edge. This despite the fact that the Polygon Help says: In three dimensions, planar polygons that do not intersect themselves will be drawn exactly as you specify them. But how does Mathematica determine that a Polygon is planar, once approximate numbers have been introduced? Somehow we need a method to specify that a 3D Polygon is to be taken as planar, regardless of round off errors. Now for examples. Needs[Graphics`Animation`] cplot = ContourPlot[x y, {x, -3, 3}, {y, -3, 3}, ColorFunction -> Hue]; Mathematica does not draw the edges of Polygons; in 3D it does.) cgraphics2d = Cases[First[Graphics[cplot]], a : {Hue[_], Polygon[_], ___} :> Take[a, 2], Infinity]; Now we convert the Polygons to 3D objects, introduce an exaggerated spacing between layers and plot it. It illustrates how Mathematica uses an overlay technique on ContourPlots. cgraphics3da = Table[Part[cgraphics2d, i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.1 i}, {i, 1, Length[cgraphics2d]}]; Show[Graphics3D[ {cgraphics3da}, Lighting -> False, ImageSize -> 450]]; Here is the same case with close spacing and an affine transformation to 3D space. cgraphics3da = Table[Part[cgraphics2d, i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.000001 i}, {i, 1, Length[cgraphics2d]}]; cgraphics3db = cgraphics3da /. {x_?NumericQ, y_?NumericQ, z_?NumericQ} -> {2x + y, -x + 2y, -1.5x + y + z}; plot1 = Show[Graphics3D[ {cgraphics3db}, Lighting -> False, ImageSize -> 450]]; SpinShow[plot1, SpinOrigin -> {0, 0, 0}, SpinDistance -> 5] SelectionMove[EvaluationNotebook[], All, GeneratedCell] FrontEndTokenExecute[OpenCloseGroup] FrontEndTokenExecute[SelectionAnimate] That works well, but if our contour regions have concave edges, we run into the second problem. cplot = ContourPlot[x^2 + y^2, {x, -3, 3}, {y, -3, 3}, ColorFunction -> Hue]; cgraphics2d = Cases[First[Graphics[cplot]], a : {Hue[_], Polygon[_], ___} :> Take[a, 2], Infinity]; cgraphics3da = Table[Part[cgraphics2d, i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.1 i}, {i, 1, Length[cgraphics2d]}]; Show[Graphics3D[ {cgraphics3da}, Lighting -> False, ImageSize -> 450]]; The 3D Polygons are rendered to extend outside the actual region, presumably because Mathematica does not recognize them as planar. So, if we do a closely spaced 3D plot as with the other function, we do not obtain properly colored regions. cgraphics3da = Table[Part[cgraphics2d, i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.00001 i}, {i, 1, Length[cgraphics2d]}]; cgraphics3db = cgraphics3da /. {x_?NumericQ, y_?NumericQ, z_?NumericQ} -> {2x + y, -x + 2y, -1.5x + y + z}; plot1 = Show[Graphics3D[ {cgraphics3db}, Lighting -> False, ImageSize -> 450]]; SpinShow[plot1, SpinOrigin -> {0, 0, 0}, SpinDistance -> 5] SelectionMove[EvaluationNotebook[], All, GeneratedCell] FrontEndTokenExecute[OpenCloseGroup] FrontEndTokenExecute[SelectionAnimate] Does anyone have any ideas for solving this problem? David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ ==== > -----Original Message----- > Sent: Friday, October 18, 2002 11:18 AM > To: mathgroup@smc.vnet.net > > > > I have 2 or more separate Plots which have different y but the same x > axes. > Like: > > Plot[Sin[x],{x,0,10}]; > Plot[1000Sin[x],{x,0,10}]; > > At the display and printout, the y axes are not aligned. Even > using the > PlotRegion and ImageSize Options doesn't help. The only way I found > was to align it manually with the mouse. > Is there a package that solves the problem? > The problem is, I have many, many plots to align... > I use Mathematica 4.0.2.0 on a Windows 2000 PC. > Who can help? > > Max > > Max, this seems to be not so easy, because of Mathematicas way to scale pictures containing text (and axes labels, tick labels etc. are texts). Texts are not rescaled when the image size changes. Tom Wickham-Jones tells in his book Mathematica Graphics in ¤10.2 at bottom of page 176: Thus Mathematica scales pictures to work with text when the PostScript is displayed. The advantage of a scaling like this is that the picture looks right. When a picture is made there is no need to ensure that enough space is left for labels. The disadvantage is that it is not possible to set the mapping of the graphic onto the page from Mathematica. This would make it possible to do things like line up sub-pictures in a GraphicsArray, something that is hard to do at present. I found out a way to do this however, with minimal experimentation (one parameter cannot be calculated, and depends on ImageSize, fonts, length of texts etc.). Before showing this, let me mention that there is (or was) a package from Michele Cappellari called MongoArray at MathSource/Enhancements/Graphics/2D/0208-538 Array of Framed Plots with Shared or Inverted Axes. He made this to plot astrophysical data, so it is somewhat specialized, but you might like to try it out. Before doing so, fix a bug which went unnoticed in prior versions of Mathematica. Replace the last line of the function linearScale e.g. with If[# == 0``5 || Log[10., Abs[#]] < 4 && # == Round[#], Round[#], #] & /@ t The idea of that package is to compose the plots and construct all embellishments, FrameTicks, TickLabels etc. as graphic objects by own means at the composed graphics.. Here now my method which uses GraphicsArray and thus preserves the full power of plotting. For example let's have two plots Plot[500*Tan[x], {x, 0, 2Pi}, PlotRange -> {{0, 2 Pi}, {-12000, 12000}}, Show[GraphicsArray[{{g1}, {g2}}]] ...does not align the plots properly, but Show[GraphicsArray[ Map[Show[FullGraphics[#], DisplayFunction -> Identity, PlotRegion -> {{0.1, 1}, {0, 1}}, PlotRange -> Tr[{FullOptions[g1, PlotRange], FullOptions[#, PlotRange]}, List, 2]] &, {{g1}, {g2}}, {2}], GraphicsSpacing -> -0.08], ImageSize -> 500] The trick is to shrink the PlotRegion such that the FullGraphics of all parts can be displayed in the plot area, and to properly adjust the PlotRanges. Of course you may include more than two plots (of functions with same domain), instead of g1 to define the PlotRange for x, you may take any of the plots involved. I reduced the GraphicsSpacing to better demonstrate the perfect match. The experimental parameter is the left edge of PlotRegion (0.1). You may lower it for larger images or must increase for larger tick labels. More complicated is to align plots with different aspect ratios, since (from Help:) GraphicsArray sets up identical rectangular display areas for each of the graphics objects it contains However I can trick that out (with more complicated manipulations of PlotRegion). The remaining problem is to adjust the final total display area. If Wolfram's show me the code of GraphicsArray (or give me more documentation) I could make it (without any modifications to GraphicsArray); until then, some experimentation is needed. If you really need that, I can tell you how, otherwise we might code our own version of GraphicsArray. But I dislike to do that, because my philosophy is to stick to standards as long as possible. -- Hartmut Wolf ==== I just installed the MathReader under MAC OS X 10.2.1 and open some demo notebook files. I found that the MathReader sometimes display a 'solid square' box on some part of the equation. Is it a bug on MathReader or OS X? Willy Reply-To: spammers-get-bounced@yahoo.com ==== Sorry for so much cross posting, but perhaps the problem has to with each / many of the NG's I am including / might find a suitable respondent on any of these. I am using Mathematica to generate a PDF plot (using Display[]), but when I look at the generated PDF file (to be subsequently included in a tex do cument using pdflatex), I get font errors. Especially if I use greek fonts, I ge t only dots in the generated pdf file. How do I fix this ? MS. ==== ``Comparison of Mathematica on Various Computers'' is now on http://www2.staff.fh-vorarlberg.ac.at/~ku/karl/mma.html (or http://smc.vnet.net/mathbench.html ) karl.unterkofler@fh-vorarlberg.ac.at for the latest version. New results Mathematica 4: Gateway 700XL Pentium 4, 2.2Ghz, 1GB RDRAM, 512kb, Windows Apple iBook 700 MHz G3, 256 MB Ram, Mac OS 9.2.2 Apple Titanium Powerbook G4, 800Mhz, 1GB, Mac OS 10.1.5 Apple PowerBook G4 400 MHz, 384 MB, Mac OS 10.1.5 Apple PowerBook G4 400 MHz, 384 MB, Mac OS 10.1.5 Pentium 4, 2.2GHz, 1GB DDR, Windows Athlon XP 1800+, ASUS A7V333, 1024 MB RAM, WinXP Pentium 4, 2.441Mhz, 1GHZ RAM, Windows .NET Server PowerBook G4, 800 Mhz, 512 MB RAM, MacOS 10.1.4 Sony Vaio GRX560, 1.6GHz Pentium 4, 512 MB, Windows XP PowerMac G4, 500MHz, 512MB, MacOS 10.1.5 Pentium III, 933 Mhz, 512 Mb, Win 98SE PowerBook G4, 800Mhz, 1GB, MacOSX 10.2.1 Compaq Deskpro EN, PIII 800, 512 MB RAM, WinNT 4.0 SP6a Intel Pentium 4, 2.53Ghz, 512 MB DDR Ram, Windows XP Pro Intel Pentium 4, overclocked to 2.764Ghz, 512 MB, Windows XP Pro PowerMac Dual G4, 1.25GHz, 2GB, MacOS 10.2.1