Rather than using Limit, which is not very reliable, I would recommend power series expansions. E.g. In[5]:= Normal[(Sin[x]/x) + (Sinh[y]/y)+O[x]+O[y]] Out[5]= 2 etc. Andrzej Kozlowski Toyama International University JAPAN http://platon.c.u-tokyo.ac.jp/andrzej/ > You have to use Limit when you want to take a limit, Mathematica won't > immidiatly do this for you. Limit[(Sinh[y]/y), y -> 0] > A particular calculation produces at an early stage the intermediate > result >> p1 = (Sin[x]/x) + (Sinh[y]/y) , (x and y both real) >> and this result then feeds into further expressions in a lengthy >> symbolic >> calculation. >> When I try to do any numerical evaluations of the final expressions >> with > either >> x or y = 0, I get Indeterminate expression or infinity 1/0 error > messages, >> even though the expressions themselves, like the expression above, are > perfectly >> determinate and finite for those limits. >> Any simple way to make this expression behave as it should under >> numerical >> evaluation? > ==== Can someone explain why... cuts = {#1 #2, #1(1 - #2), (1 - #1)#3, (1 - #1)(1 - #3)} & @@@ RandomArray[UniformDistribution[0, 1], {100000, 3}]; Dimensions[Select[cuts, Min[#] > .1 &]] // Timing Calculates in about 1 second, but the equivalent (but I thought more memory efficient)... Dimensions[ Select[{#1 #2, #1(1 - #2), (1 - #1)#3, (1 - #1)(1 - #3)} & @@@ RandomArray[UniformDistribution[0, 1], {100000, 3}], Min[#] > .1 &]] // Timing Takes more than 4 times longer to compute. Note that if you take out the processing of the random array, the problem isn't so strong, but still it seems the condensed code is faster by about 10%. In[73]:= rnds=RandomArray[UniformDistribution[0,1],{100000,3}]; Dimensions[Select[rnds,Min[#]>.1&]]//Timing Out[74]= {1.532 Second,{72861,3}} In[75]:= Dimensions[ Select[RandomArray[UniformDistribution[0,1],{100000,3}], Min[#]>.1&]]//Timing Out[75]= {1.742 Second,{73127,3}} Look forward to hearing other peoples comments. Chris ==== if I were to give to somebody an encoded (with Encode) Mathematica file is the person able to view the content of the file? If so, how and also how to prevent it? I understand that the commands like Get[] (<<) enable the user to read the file into the Mathematica session (which is okay). Any pointers to the web sites or explanation greatly appreciated. If you decide that these matters should not be discussed on this forum publicly please contact me directly. JK. ==== with this problem: I use my own style sheet with a background for the hole notebook set to black (GrayLevel[0]). Now, because the of default option: ColorOutput->GrayLevel[0] for commands like Plot, I have to begin my sessions with a command like this: SetOptions[{Plot,ListPlot,...},ColorOutput->color] so I can see any plot I do. My question is: How can I do, so that Mathematica evaluates this command every time I begin a session but only if I use my own style sheet?. I mean, if for example I use the default style sheet, Mathematica doesn't take care of this command. César Guerra Secc. Fisica - PUCP Lima. __________________________________________________ Do You Yahoo!? Yahoo! Movies - coverage of the 74th Academy Awards® http://movies.yahoo.com/ ==== you can't see the plot on a black background because the default drawing color is black. Set the options of Plot, ListPlot ... to SetOptions[Plot, ColorOutput :> If[$Notebooks && GrayLevel[0.] === (Background /. Union[ Cases[ Options[SelectedNotebook[]], HoldPattern[Background -> _], Infinity ] ]), (* Then *) ((# /. GrayLevel[a_] :> GrayLevel[1 - a]) &), (* Else *) Automatic] ] may help. Jens with this problem: I use my own style sheet with a background for the > hole notebook set to black (GrayLevel[0]). Now, > because the of default option: > ColorOutput->GrayLevel[0] for commands like Plot, I > have to begin my sessions with a command like this: SetOptions[{Plot,ListPlot,...},ColorOutput->color] so I can see any plot I do. > My question is: How can I do, so that Mathematica > evaluates this command every time I begin a session > but only if I use my own style sheet?. I mean, if for > example I use the default style sheet, Mathematica > doesn't take care of this command. > César Guerra > Secc. Fisica - PUCP > Lima. __________________________________________________ > Do You Yahoo!? > Yahoo! Movies - coverage of the 74th Academy Awards® > http://movies.yahoo.com/ ==== I want to add to a table two columns that match the last column, and two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], Transpose[tab1][[-1]]]]; tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm However, I bet there are much more efficient and elegant ways of doing this. Any suggestions? are extremely helpful. Phil -- Philip M. Howe Program Manager, Stockpile Surety Los Alamos National Laboratory (505) 665-5332 (505) 667-9498 Fax: 505-665-5249 ==== is mm = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; PadRight[#, 6, Last[#]] & /@ mm elegant ?? Jens > I want to add to a table two columns that match the last column, and > two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I > end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { > 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; > tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm However, I bet there are much more efficient and elegant ways of > doing this. Any suggestions? are extremely helpful. > Phil > -- > Philip M. Howe > Program Manager, Stockpile Surety > Los Alamos National Laboratory (505) 665-5332 > (505) 667-9498 > Fax: 505-665-5249 ==== The function PadRight may prove useful for you. For example, with tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; we can add two rows with PadRight[tab1, Dimensions[tab1]+{2,0},List[tab1[[-1]]]] and we can add two columns with PadRight[tab1, Dimensions[tab1]+{0,2},List/@tab1[[All,-1]]] The List statement in the first example is actually unnecessary, but makes it clear how to go about adding two columns as in the second example. Carl Woll Physics Dept U of Washington I want to add to a table two columns that match the last column, and > two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I > end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { > 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; > tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm > However, I bet there are much more efficient and elegant ways of > doing this. Any suggestions? are extremely helpful. > Phil > -- > Philip M. Howe > Program Manager, Stockpile Surety > Los Alamos National Laboratory (505) 665-5332 > (505) 667-9498 > Fax: 505-665-5249 > ==== Philip, Here I time a different way of doing what you want: data= Table[Random[Integer,{0,9}],{500},{600}]; (a1= data[[Join[#1,{-1,-1}]]][[All,Join[#2,{-1,-1}]]]&@@(Range/@ Dimensions[data]) );//Timing {0.27 Second,Null} Compare with your code tab1=data; (a2= (tab1c = Transpose[ Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], Transpose[tab1][[-1]]]]; tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] ) );//Timing {3.13 Second,Null} Check for correctness: a1===a2 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 Fax: +44 (0)870 164 0565 I want to add to a table two columns that match the last column, and > two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I > end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { > 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; > tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm > However, I bet there are much more efficient and elegant ways of > doing this. Any suggestions? are extremely helpful. > Phil > -- > Philip M. Howe > Program Manager, Stockpile Surety > Los Alamos National Laboratory (505) 665-5332 > (505) 667-9498 > Fax: 505-665-5249 > ==== Philip, Try this: f[a_?MatrixQ] := Join[#, #[[{-1, -1}]]] & /@ Join[a, a[[{-1, -1}]]] tbl = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; f[tbl] // MatrixForm Paul >>>>>>>>>>>>>> I want to add to a table two columns that match the last column, and two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], Transpose[tab1][[-1]]]]; tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm However, I bet there are much more efficient and elegant ways of doing this. Any suggestions? are extremely helpful. Phil -- Philip M. Howe Program Manager, Stockpile Surety Los Alamos National Laboratory (505) 665-5332 (505) 667-9498 Fax: 505-665-5249 ==== Phil, try this using rules mylist = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; In[2]:=mylist /. {x__Integer, y_Integer} -> {x, y, y, y} /. {x__, y_} -> {x, y, y, y} Out[2]={{1, 2, 3, 4, 4, 4}, {5, 6, 7, 8, 8, 8}, {9, 10, 11, 12, 12, 12}, {9, 10, 11, 12, 12, 12}, {9, 10, 11, 12, 12, 12}} Cheers, Brian I want to add to a table two columns that match the last column, and > two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I > end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { > 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; > tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm > However, I bet there are much more efficient and elegant ways of > doing this. Any suggestions? are extremely helpful. > Phil > -- > Philip M. Howe > Program Manager, Stockpile Surety > Los Alamos National Laboratory (505) 665-5332 > (505) 667-9498 > Fax: 505-665-5249 ==== >I want to add to a table two columns that match the last column, and >two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I >end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { >9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; >tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm >However, I bet there are much more efficient and elegant ways of >doing this. Any suggestions? are extremely helpful. > tab1=Partition[Range[12],4]; tab1 /. {x__, y_?AtomQ}->{x,y,y,y} /. {x__,y_}->{x,y,y,y} Which can be generalized readily to add n columns and m rows n=3; m=4; tab1 /. {x__, y_?AtomQ}-> {x,Sequence@@Table[y,{n+1}]} /. {x__,y_}->{x,Sequence@@Table[y,{m+1}]} Or Join[ tab1c=Join[#,{Last[#]},{Last[#]}]& /@ tab1, {Last[tab1c]},{Last[tab1c]}] Which can be generalized readily to add n columns and m rows Join[ tab1c=Join[#,Sequence@@ Table[{Last[#]},{n}]]& /@ tab1, Sequence@@Table[{Last[tab1c]},{m}]] Bob Hanlon Chantilly, VA USA ==== Philip: This may help: cols[l_List]:=Module[{tab2=Flatten/@({#,{#[[-1]]}, {#[[-1]]}}&/@l)},Join[tab2,{Last[tab2]},{Last[tab2]}]] Best, Harvey Harvey P. Dale University Professor of Philanthropy and the Law Director, National Center on Philanthropy and the Law New York University School of Law Room 206A 110 West 3rd Street New York, N.Y. 10012-1074 -----Original Message----- This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], Transpose[tab1][[-1]]]]; tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm However, I bet there are much more efficient and elegant ways of doing this. Any suggestions? are extremely helpful. Phil -- Philip M. Howe Program Manager, Stockpile Surety Los Alamos National Laboratory (505) 665-5332 (505) 667-9498 Fax: 505-665-5249 ________________________________________________________________________ service. For more information on a proactive anti-virus service working around the clock, around the globe, visit http://www.messagelabs.com ________________________________________________________________________ ==== > -----Original Message----- > Sent: Thursday, March 21, 2002 3:27 PM > To: mathgroup@smc.vnet.net I want to add to a table two columns that match the last column, and > two rows that match the last row. Thus, if my table is {{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I > end up with {{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { > 9,10,11,12,12,12}, {9,10,11,12,12,12}}; This works: tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; > tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm > However, I bet there are much more efficient and elegant ways of > doing this. Any suggestions? are extremely helpful. > Phil > -- > Philip M. Howe > Program Manager, Stockpile Surety > Los Alamos National Laboratory (505) 665-5332 > (505) 667-9498 > Fax: 505-665-5249 > Phil, look at In[12]:= napp = 2; In[13]:= Nest[Transpose[Join[#, Table[Last[#], {napp}]]] &, tab1, 2] // MatrixForm You may tune napp, but not the second 2 appearing. -- Hartmut Wolf ==== Bob, A variant of your replacement method: Replace[data, {x___, y_} -> {x, y, y, y}, {0, 1}] -- 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 Fax: +44 (0)870 164 0565 >I want to add to a table two columns that match the last column, and >two rows that match the last row. >Thus, if my table is >{{1,2,3,4},{5,6,7,8},{9,10,11,12}}; I want to modify it such that I >end up with >{{1,2,3,4,4,4}, {5,6,7,8,8,8}, {9,10,11,12,12,12}, { >9,10,11,12,12,12}, {9,10,11,12,12,12}}; >This works: >tab1 = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}; >tab1c = Transpose[ > Append[Append[Transpose[tab1], Transpose[tab1][[-1]]], > Transpose[tab1][[-1]]]]; >tab1d = Append[Append[tab1c, tab1c[[-1]]], tab1c[[-1]]] // TableForm > >However, I bet there are much more efficient and elegant ways of >doing this. Any suggestions? >are extremely helpful. tab1=Partition[Range[12],4]; tab1 /. {x__, y_?AtomQ}->{x,y,y,y} /. {x__,y_}->{x,y,y,y} Which can be generalized readily to add n columns and m rows n=3; m=4; tab1 /. {x__, y_?AtomQ}- {x,Sequence@@Table[y,{n+1}]} /. {x__,y_}->{x,Sequence@@Table[y,{m+1}]} Or Join[ > tab1c=Join[#,{Last[#]},{Last[#]}]& /@ tab1, > {Last[tab1c]},{Last[tab1c]}] Which can be generalized readily to add n columns and m rows Join[ > tab1c=Join[#,Sequence@@ > Table[{Last[#]},{n}]]& /@ tab1, > Sequence@@Table[{Last[tab1c]},{m}]] > Bob Hanlon > Chantilly, VA USA > ==== Can somebody to help me to find a solution of approximation of a function? I have a function f[x_]:=a*x+b*x^2+c*x^3, where a,b,c are known numbers. I would like to find a simplier function for f, for example g[x]=c1 x^c2 at an given interval with specified precision. How can I find the numbers c1 and c2? ==== Can somebody to help me to find a solution of approximation of a function? I have a function f[x_]:=a*x+b*x^2+c*x^3, where a,b,c are known numbers. I would like to find a simplier function for f, for example g[x]=c1 x^c2 at an given interval with specified precision. How can I find the numbers c1 and c2? ==== You can choose the interval, model, and fitting criterion, but you will be stuck the goodness of fit determined by these choices. Here I choose your suggested model, the interval [0.1, 1], and default measure of fit, unweighted sum of squares of deviations, over equally spaced points on the interval. In[349]:= < I have a function f[x_]:=a*x+b*x^2+c*x^3, where a,b,c are known numbers. I > would like to find a simplier function for f, for example g[x]=c1 x^c2 at an > given interval with specified precision. How can I find the numbers c1 and c2? ==== I guess you might use some kind of fit with the model g, giving some points extracted from f. Now, if you have f, why would you want to find a function to approximate it? f is simple enough, i.e. quadratic on x, whereas the g you get from fitting could actually turn to be more complicated. Do you think a function of x, where x enters with a possibly non-integral exponent, is simpler than a polynomial of degree 2? Tomas Garza Mexico City ----- Original Message ----- ==== >Can somebody to help me to find a solution of approximation of a function? >I have a function f[x_]:=a*x+b*x^2+c*x^3, where a,b,c are known numbers. >I >would like to find a simplier function for f, for example g[x]=c1 x^c2 >at an >given interval with specified precision. How can I find the numbers c1 >and > c2? > Use NonlinearFit Needs[Graphics`Colors`]; Needs[Statistics`NonlinearFit`]; Clear[a,b,c,f,g]; f[x_]:=a*x+b*x^2+c*x^3; a=5; b=7; c=1; xmin = 2; xmax=5; data = Table[{x,f[x]}, {x,xmin,xmax,(xmax-xmin)/10}]; g[x_] := Evaluate[ NonlinearFit[data, c1*x^c2, x, {c1,c2}]]; g[x] Plot[{f[x], g[x]}, {x, xmin-1, xmax+1}, PlotStyle->{Blue, Red}, Epilog->{AbsolutePointSize[4], Point/@data}]; However, for a given model you get the fit that you get. It is the best fit for that model but you cannot control the precision without changing the model. a=10; b=-6; c=1; data = Table[{x,f[x]}, {x,xmin,xmax,(xmax-xmin)/10}]; g[x_] := Evaluate[ NonlinearFit[data, c1*x^c2, x, {c1,c2}]]; g[x] Plot[{f[x], g[x]}, {x, xmin-1, xmax+1}, PlotStyle->{Blue, Red}, Epilog->{AbsolutePointSize[4], Point/@data}]; Adding a constant term to the model improves the fit g[x_] := Evaluate[ NonlinearFit[data, c3+c1*x^c2, x, {c1,c2,c3}]]; g[x] Plot[{f[x], g[x]}, {x, xmin-1, xmax+1}, PlotStyle->{Blue, Red}, Epilog->{AbsolutePointSize[4], Point/@data}]; Bob Hanlon Chantilly, VA USA ==== A number of people recently sent messages to the MathGroup asking where they could get some free tips on Mathematica. Well I don't post messages as often as I used to so, some of you may not be aware of the tips on my web-site, which you can download as Mathematica notebooks. I figured I would take this time to suggest you check my site at http://www.verbeia.com/mathematica/tips/Tricks.html Ted Ersek ==== Is there a way to change the axes values when using ListPlot3D? The axes always run from 1 to the highest element number. I would like to change them to correspond to the actual values used to generate data. For instance, I generate some data using Table[x+y,{y,-3,4},{x,3,8}] and then feed it to ListPlot3D. The x axis runs from 1 to 6 and the y axis runs from 1 to 8. What I want is the x axis to run from 3 to 8 the the y axis to run from -3 to 4. ListPlot allows the use of x,y pairs which assigns specific values to the x axis, but I can't figure out how to do the analogous thing for ListPlot3D. Allan de Frates ==== I found that creating a function with Options (named arguments) was clunky SetAttributes[withOptions, HoldAll]; withOptions[defaults_, overrides_, body_] := ReleaseHold[Hold[body]/.Evaluate[overrides]/.Evaluate[defaults]] With that defined, creating a function with Options is a little cleaner. For example: Options[f] = {a -> 1, b -> 2}; f[x_, opts___] := withOptions[Options[f], {opts}, (* body of f here... *) {x,a,b} ] One problem with that is that 2 functions with the same options can't call each other. So maybe the following version is better: SetAttributes[withOptions, HoldAll]; withOptions[defaults_, overrides_, body_]:= ReleaseHold[ Hold[body] /. (opt[#1]->#2&) @@@ Join[Evaluate[overrides],Evaluate[defaults]]] and now the example would be defined as like so: Options[f]= {a -> 1, b -> 2}; f[x_, opts___] := withOptions[Options[f], {opts}, (* body of f here... *) {x, opt@a, opt@b} (* can now call another func with the same option: g[a->opt@a] *) ] Can anyone see problems with this, or have a better way to do it? -- -- -- -- -- -- -- -- -- -- -- -- Daniel Reeves http://ai.eecs.umich.edu/people/dreeves/ In science one tries to tell people, in such a way as to be understood by everyone, something that no one ever knew before. In poetry, it's the exact opposite. -- Paul Dirac (1902-1984) ==== I wonder if there is a Mathematica command that does what the menu item Copy As --> Formatted Text does? I am trying to automate a process of copying a text only cell from Mathematica to another program. The menu command works fine, but I would like to be able to run the command that generates the text cell and automatically select the generated cell and copy it as formatted text.... is that possible? Tom De Vries ==== Joel, You want to use the ToFileName command. Here is an example of exporting a plot as a .gif image. (using directories in my Applications folder) plot1 = Plot[Sin[x], {x, 0, 2 Pi}]; Export[ToFileName[{AddOns, Applications, Communications, MathGroup Responses}, sinplot.gif], plot1, GIF] The file was created in the folder... AddOnsApplicationsCommunicationsMathGroup Responsessinplot.gif David Park djmp@earthlink.net http://home.earthlink.net/~djmp/ When using the Export command to save an eps > file, it lands up in the Mathematica 4.0 Files > directory (folder). How do I direct the file to > another destination ? > ==== For a single export, just give the entire path as the filename argument. For example: g = Plot[x^2, {x, -1, 1}]; Export[c:mydataplot.eps, g, EPS] The above path format, with doubled backslashes, works for the Windows platform. (Single backslashes in a string may be interpreted as escape characters.) To change the directory for multiple exports at the current sesssion, you may use SetDirectory. For example: SetDirectory[c:mydata] Export[plot.eps, g, EPS] When using the Export command to save an eps > file, it lands up in the Mathematica 4.0 Files > directory (folder). How do I direct the file to > another destination ? -- Murray Eisenberg murray@math.umass.edu Mathematics & Statistics Dept. Lederle Graduate Research Tower phone 413 549-1020 (H) University of Massachusetts 413 545-2859 (W) 710 North Pleasant Street Amherst, MA 01375 ==== Change your current working directory. To check for current working directory In[9]:=Directory[] Out[9]=Macintosh HD:Mathematica 4.0 Files Use the same format as above to change the working directory with SetDirectory, In[10]:= SetDirectory[Macintosh HD:Users:yasvirat:Desktop] Out[10]= Macintosh HD:Users:yasvirat:Desktop Cheers Yas > When using the Export command to save an eps > file, it lands up in the Mathematica 4.0 Files > directory (folder). How do I direct the file to > another destination ? > ==== I feel it is a stupid question ... but I must risk to get disgraced... If there are three tables of values (2 tables of input-data and one table of output-data) and I am looking for a (non trigonometric) function combining the first two tables to receive the values of the third table ... how could I manage this with Mathematica? Thanx a lot, Harry ==== I'm not altogether sure I understand your question, but... In[1]:= a={a1,a2,a3}; b={b1,b2,b3}; In[3]:= c=fn[#[[1]],#[[2]]]&/@Transpose[{a,b}] Out[3]= {fn[a1,b1],fn[a2,b2],fn[a3,b3]} Tomas Garza Mexico City ----- Original Message ----- > third table ... how could I manage this with Mathematica? > Thanx a lot, > Harry ==== >I'm not altogether sure I understand your question, but... In[1]:= >a={a1,a2,a3}; >b={b1,b2,b3}; In[3]:= >c=fn[#[[1]],#[[2]]]&/@Transpose[{a,b}] >Out[3]= >{fn[a1,b1],fn[a2,b2],fn[a3,b3]} > You can perform this operation with Thread a={a1,a2,a3}; b={b1,b2,b3}; c=Thread[fn[a,b]] {fn[a1, b1], fn[a2, b2], fn[a3, b3]} Bob Hanlon Chantilly, VA USA ==== one. If there are two tables of observations: a={{x0, a0}, {x1, a1}, ..., {x255, a255}}; b={{x0, b0}, {x1, b1}, ..., {x255, b255}}; ( a is independent on b ) and another table: c={{x1, c0}, {x1, c1}, ..., {x255, c255}}; how can I manage Mathematica to find a function g to combine a with b to receive (the known values of ) c, because we are interested on the relationship g ? Harry -- Harald von der Osten-Woldenburg Geophysical Prospection of Archaeological Sites National Heritage Department of Baden-Wuerttemberg Silberburgstrasse 193, D-70178 Stuttgart Fax Office: +49-(0)711-1694-707 http://www.lb.netic.de/hvdosten : Geomagnetics, Geoelectrics, Radar, EMI ==== Dear Mr Ersek, Thank you very much for your prompt, almost immediate help. Your solution looks very nice, and it *does* reproduce all the required messages (none of them is lost). However, it looks like that your piece of code also quoted up to dozen warning messages which were absent at the computation of the original input, Integrate[ArcTan[1 - Sqrt[1 - z^(-1)]], {z, -1, 1}]; such as # 1 (absent at the original computation) Infinity::indet: Indeterminate expression 0 (- Infinity)encountered. # 2 (absent at the original computation) Solve::tdep: The equations appear to involve the variables to be solved for in an essentially non-algebraic way. # 3 (absent at the original computation) Solve::ifun: Inverse functions are being used by Solve, so some solutions may not be found. # 4 (absent at the original computation) Infinity::indet: Indeterminate expression 0 Infinity encountered. # 5 (absent at the original computation) Power::infy: Infinite expression 1/0^2 encountered. # 6 (absent at the original computation) Power::infy: Infinite expression 1/0 encountered. # 7 (absent at the original computation) ArcTan::indet: Indeterminate expression ArcTan[0, 0] encountered. etc How could I cut off these spurious messages, and get only 4 warning messages which came during the actual evaluation (3 $MaxExtraPrecision::meprec, and 1 General::stop) ? Vladimir Bondarenko P.S. Here is my input, cell by cell. **************************************************************************** ************* (* Cell # 1 *) MyMessageList[_Integer] := Hold[]; $ModifyMessage = True; Unprotect[Message]; Message[args__] /; $ModifyMessage := Block[{$ModifyMessage}, If[MyMessageList[$Line] === Hold[], MyMessageList[$Line] = Hold[Message[args];], (*else*) MyMessageList[$Line] = Insert[MyMessageList[$Line], Unevaluated[Message[args]], {1, -2}]]; Message[args]]; Protect[Message]; .......................................................................... (* Cell # 2 *) Integrate[ArcTan[1-Sqrt[1-z^(-1)]],{z,-1,1}]; .......................................................................... (* Cell # 3 *) messgs = MyMessageList[6]; .......................................................................... (* Cell # 4 *) ReleaseHold[messgs] .......................................................................... ==== Vladimir Bondarenko wanted to make it so he could see the full text of messages from a specific In[] line. The other day I provided a solution that seemed to do the trick, but Vladimir noted that it collects lots of spurious messages from evaluating the following input. In[6]:= Integrate[ArcTan[1-Sqrt[1-z^(-1)]], {z,-1,1}] I improved on my ealier solution. After evaluating the code below you can evaluate FullMessageList[6] and get the messages (unevaluated) that resulted from In[6] except the (General::stop) message isn't included. Curiously the (General::stop) message is displayed if you use ReleaseHold on the messages returned by FullMessageList. (********* Note **********) I was in the mood for writing robust code today, so I use Apply[f1, expr1, Heads->False] and Map[f2, expr2, Heads->False] instead of the shorter forms (f1@@expr1) and (f2/@expr2) respectively. By using the longer forms my function definitions don't care what the option is set to via SetOptions. This is a point you should keep in mind if you are trying to write robust Mathematica programs. --------------------- Get Mathematica Tips, Tricks from http://www.verbeia.com/mathematica/tips/Tricks.html Ted Ersek (***** Code Starts Here ****************) Unprotect[Message]; MyMessageList[_Integer]:= Hold[]; $ModifyMessage=True; Message[name_,args__]/;$ModifyMessage:= Block[{$ModifyMessage}, (* If the message isn't Off it will be displayed due to evaluating the begining of the If statement. *) If[(Message[name,args]=!=$Off[])&&(Count[MyMessageList[$Line],Unevaluated[na me],-1]<3), If[ MyMessageList[$Line]===Hold[], MyMessageList[$Line]=Hold[Message[name,args];], (* else *) MyMessageList[$Line]= Insert[MyMessageList[$Line],Unevaluated[Message[name,args]],{1,-2}] ]; ] ] Protect[Message]; FullMessageList[n_]:= Module[{s1,s2,s3,posn,TempHold1,TempHold2,result}, Attributes[HoldTemp1]=Attributes[HoldTemp2]={HoldAll}; s1=MyMessageList[n]/.m_MessageName:>HoldTemp1[m]; s2=Apply[HoldTemp1,MessageList[n],1,Heads->False]; s3=Map[{#,Count[s2,#]}&,Union[s2],Heads->False]; posn=Apply[Position[s1,#1,-1,#2]&,s3,1,Heads->True]; posn=Map[Drop[#,-1]&,Flatten[posn,1],Heads->False]; result=Extract[MyMessageList[n]/.Message->HoldTemp2,Sort[posn] ]; result=Apply[Hold,result ,Heads->False]; result=Apply[HoldForm, {result}/.HoldTemp2->Message, Heads->False]; Part[result,1,0]=CompoundExpression; result ] ==== OK, so you can use ComplexExpand expand to find the symbolic real and imag parts of an expression -- e.g. the input zComplex = ComplexExpand[ Sin[a+I b], TargetFunctions->{Re,Im}] gives as output Cosh[b] Sin[a] + I Cos[a] Sinh[b] as desired. But now, how do I get Mathematica to peel out the symbolically real and imaginary parts of this? -- that is, what inputs zR = ??? zI = ??? will give as outputs Cosh[b] Sin[a] and Cos[a] Sinh[b] (Maybe an example in the ComplexExpand Help file would be helpful?) ==== as you do it wit paper and pencil SymbolicRe[z_] := (z + (z /. Complex[a_, b_] :> Complex[a, -b]))/2 SymbolicIm[z_] := (z - (z /. Complex[a_, b_] :> Complex[a, -b]))/(2 I) Jens OK, so you can use ComplexExpand expand to find the symbolic real and imag > parts of an expression -- e.g. the input zComplex = ComplexExpand[ Sin[a+I b], TargetFunctions->{Re,Im}] gives as output Cosh[b] Sin[a] + I Cos[a] Sinh[b] as desired. But now, how do I get Mathematica to peel out the symbolically real and > imaginary parts of this? -- that is, what inputs zR = ??? zI = ??? will give as outputs Cosh[b] Sin[a] and Cos[a] Sinh[b] (Maybe an example in the ComplexExpand Help file would be helpful?) ==== aes Try Im[zComplex] which gives Im[Cosh[b] Sin[a]]+Re[Cos[a] Sinh[b]] That looks a little strange until you realize that the Im[] portion is 0 if a and b are real, i.e. Mathematica doesn't assume anything. -- Rodney Sparapani Medical College of Wisconsin Sr. Biostatistician Patient Care & Outcomes Research (PCOR) rsparapa@mcw.edu http://www.mcw.edu/pcor Was 'Name That Tune' rigged? WWLD -- What Would Lombardi Do ==== How about simply: In[3]:= ComplexExpand[Re[Sin[a+I b]]] Out[3]= Cosh[b] Sin[a] In[4]:= ComplexExpand[Im[Sin[a+I b]]] Out[4]= Cos[a] Sinh[b] ?? > OK, so you can use ComplexExpand expand to find the symbolic real and > imag > parts of an expression -- e.g. the input zComplex = ComplexExpand[ Sin[a+I b], TargetFunctions->{Re,Im}] gives as output Cosh[b] Sin[a] + I Cos[a] Sinh[b] as desired. But now, how do I get Mathematica to peel out the > symbolically real and > imaginary parts of this? -- that is, what inputs zR = ??? zI = ??? will give as outputs Cosh[b] Sin[a] and Cos[a] Sinh[b] (Maybe an example in the ComplexExpand Help file would be helpful?) > Andrzej Kozlowski Toyama International University JAPAN http://platon.c.u-tokyo.ac.jp/andrzej/ ==== A way for doing what you want: In[18]:= Simplify[Re[Cosh[b] Sin[a] + I Cos[a] Sinh[b]],{a>0,b>0}] Out[18]= Cosh[b] Sin[a] In[19]:= Simplify[Im[Cosh[b] Sin[a] + I Cos[a] Sinh[b]],{a>0,b>0}] Out[19]= Cos[a] Sinh[b] ----- Original Message ----- > Cosh[b] Sin[a] + I Cos[a] Sinh[b] as desired. But now, how do I get Mathematica to peel out the symbolically real and > imaginary parts of this? -- that is, what inputs zR = ??? zI = ??? will give as outputs Cosh[b] Sin[a] and Cos[a] Sinh[b] (Maybe an example in the ComplexExpand Help file would be helpful?) ==== Try the following: In[19]:= zComplex = ComplexExpand[Sin[a + I*b], TargetFunctions -> {Re, Im}] realz = ComplexExpand[Re[zComplex]] imz = ComplexExpand[Im[zComplex]] Out[19]= Cosh[b]*Sin[a] + I*Cos[a]*Sinh[b] Out[20]= Cosh[b]*Sin[a] Out[21]= Cos[a]*Sinh[b] In fact you can skip the first step: In[16]:= myz = Sin[a + I*b] realmyz = ComplexExpand[Re[myz]] imagmyz = ComplexExpand[Im[myz]] Out[16]= Sin[a + I*b] Out[17]= Cosh[b]*Sin[a] Out[18]= Cos[a]*Sinh[b] Adam Smith > aes Try Im[zComplex] which gives Im[Cosh[b] Sin[a]]+Re[Cos[a] Sinh[b]] That looks a little strange until you realize that the Im[] portion is 0 if a and b are real, i.e. Mathematica doesn't assume anything. ==== symbolic real and imag parts of an expression is Real part = ComplexExpand[Re[expr]] Imag part = ComplexExpand[Im[expr]] and also my apologies for belatedly realizing that I had raised this question once before, months ago; gotten the same answer; and forgotten it. It's now stored in my online collection on Mathematica hints and kinks. Might as well also repeat the same comment that I made last time, however, namely that writing the expression in this form seems syntactically bizarre, not so say nonsensical. The expression ComplexExpand[Re[Sin[a + I b]]] would normally be interpreted as saying, in words, Do a complex expansion of the real part of the sine of a + I B, presumably producing a complex result, including adding a + I 0 to make the result complex. What's really wanted, however, and what's actually accomplished by this expression, is instead, Take the real part of the complex expansion of the sine of a + I b, a result you would expect to be written as Re[ComplexExpand[Sin[a+I b]]] It's sort of like having to write Log[Sin[z]] when what you want is Sin[Log[z]] > OK, so you can use ComplexExpand expand to find the symbolic real and imag > parts of an expression -- e.g. the input zComplex = ComplexExpand[ Sin[a+I b], TargetFunctions->{Re,Im}] gives as output Cosh[b] Sin[a] + I Cos[a] Sinh[b] as desired. But now, how do I get Mathematica to peel out the symbolically > real and > imaginary parts of this? -- that is, what inputs zR = ??? zI = ??? will give as outputs Cosh[b] Sin[a] and Cos[a] Sinh[b] (Maybe an example in the ComplexExpand Help file would be helpful?) ==== Gentlemen, What is the simplest way to implement the step # 2 ? using the same machine > 2. Pass an input to the child MathKernel 3. Evaluate the passed input within the child MathKernel 4. Return the evaluated input into the parent MathKernel 5. Close the child MathKernel Vladimir Bondarenko P.S. If I try something like > ReadList[!MathKernel, 2 + 1, RecordLists -> True] ReadList::readf: 3 is not a valid format specification. ReadList[!MathKernel, 3, RecordLists -> True] then I probably use the parent (old) instance of the MathKernel. If I use > ReadList[Run[MathKernel.exe], 2 + 1, RecordLists -> True] General::stream: 0 is not a string, InputStream[ ], or OutputStream[ ]. ReadList[0, 3, RecordLists -> True] then I do run the child MathKernel, but it looks like that the computation was done, again, by the parent MathKernel 8-( ==== the online-manual gives an example as well as THE BOOK Open the link: In[]:=link = LinkLaunch[math -mathlink] send an expression: In[]:=LinkWrite[link, Unevaluated[EvaluatePacket[Expand[(x + 1)^3]]]] read the data the link returns: In[]:=LinkRead[link]; LinkRead[link] Out[]=ReturnPacket[1 + 3 x + 3 x^2 + x^3] In[]:=LinkClose[link] Jens Gentlemen, What is the simplest way to implement the step # 2 ? using the same machine > 2. Pass an input to the child MathKernel > 3. Evaluate the passed input within the child MathKernel > 4. Return the evaluated input into the parent MathKernel > 5. Close the child MathKernel Vladimir Bondarenko P.S. If I try something like > ReadList[!MathKernel, 2 + 1, RecordLists -> True] ReadList::readf: 3 is not a valid format specification. ReadList[!MathKernel, 3, RecordLists -> True] then I probably use the parent (old) instance of the MathKernel. If I use > ReadList[Run[MathKernel.exe], 2 + 1, RecordLists -> True] General::stream: 0 is not a string, InputStream[ ], or OutputStream[ ]. ReadList[0, 3, RecordLists -> True] then I do run the child MathKernel, but it looks like that the computation > was done, again, by the parent MathKernel 8-( ==== > What is the simplest way to implement the step # 2 ? using the same machine > 2. Pass an input to the child MathKernel > 3. Evaluate the passed input within the child MathKernel > 4. Return the evaluated input into the parent MathKernel > 5. Close the child MathKernel Using file I/O operations is probably not the best way to go about this. Try using MathLink communication instead. See the example in Section 2.12.7 of _The Mathematica Book_ (Fourth Edition) http://documents.wolfram.com/v4/MainBook/2.12.7.html -- User Interface Programmer paulh@wolfram.com Wolfram Research, Inc. Disclaimer: Opinions expressed herein are those of the author alone. ==== Integrate[Expand[D[Erf[x^2 + x], x]], x] leaves an unevaluated integral. In Mathematica 4.1. ==== If you use Intepolation on these data, it looks strange, why? mm={{0.8,1/0.8},{0.9,1/0.9},{2.8,1/2.8},{5.8,1/5.8},{5.9,1/5.9}}; I did: imm=Interpolation[mm]; Plot[imm[t],{t,0.8,5.9},PlotRange->All, Epilog->Evaluate[mm/.{a_,b_}->{AbsolutePointSize[10],Point[{a,b}]}]]; The resulting curve goes through all points but it deviates between points? I have tred different intepolationorder values. Peter W ==== try imm = Interpolation[mm, InterpolationOrder -> 4]; Jens If you use Intepolation on these data, it looks strange, why? mm={{0.8,1/0.8},{0.9,1/0.9},{2.8,1/2.8},{5.8,1/5.8},{5.9,1/5.9}}; I did: imm=Interpolation[mm]; Plot[imm[t],{t,0.8,5.9},PlotRange->All, > Epilog->Evaluate[mm/.{a_,b_}->{AbsolutePointSize[10],Point[{a,b}]}]]; The resulting curve goes through all points but it deviates between > points? I have tred different intepolationorder values. Peter W ==== I don't know what you mean by it deviates between points. Perhaps you mean the interpolating function doesn't have a credible behavior, right? Let me quote Stan Wagon on this: Getting a smooth curve through some data points is not always enough. Sometimes it is critical to preserve the general shape suggested by the data. This question is treated in Mathematica in Education and Research, Vol. 8, 3-4, p. 103. There is a very good package written by Stan, which you may get from him at wagon@macalester.edu . I have used it and I think it is extremely useful in the kind of problems you allude to. Tomas Garza Mexico City ----- Original Message ----- > Plot[imm[t],{t,0.8,5.9},PlotRange->All, > Epilog->Evaluate[mm/.{a_,b_}->{AbsolutePointSize[10],Point[{a,b}]}]]; The resulting curve goes through all points but it deviates between > points? I have tred different intepolationorder values. Peter W > ==== >If you use Intepolation on these data, it looks strange, why? mm={{0.8,1/0.8},{0.9,1/0.9},{2.8,1/2.8},{5.8,1/5.8},{5.9,1/5.9}}; I did: imm=Interpolation[mm]; Plot[imm[t],{t,0.8,5.9},PlotRange->All, > Epilog->Evaluate[mm/.{a_,b_}->{AbsolutePointSize[10],Point[{a,b}]}]]; The resulting curve goes through all points but it deviates between >points? I have tred different intepolationorder values. > mm={{0.8,1/0.8},{0.9,1/0.9},{2.8,1/2.8}, {5.8,1/5.8},{5.9,1/5.9}}; imm=Interpolation[mm, InterpolationOrder->Length[mm]-1]; Plot[imm[t],{t,0.8,5.9}, PlotRange->All, Epilog->{AbsolutePointSize[6],Point/@mm}]; ip = InterpolatingPolynomial[mm,t]//Expand Plot[ip,{t,0.8, 5.9}, PlotRange->All, Epilog->{AbsolutePointSize[6],Point/@mm}]; Bob Hanlon Chantilly, VA USA ==== coming from the matlab world, I am used to operating on subgroups of elements in arbitrary dimensions of multidimensional matrices. An example of such an operation would be the calculation of the maximum value over all elements in a particular dimension, i.e. apply max() on all elements in the desired dimension for all index combinations in the remaining dimensions, resulting in matrix with one less dimension than the original matrix. Is there a neat (built-in) way to do this in Mathematica? Numerical example (2D): aa = {{11,12,13},{21,22,23}}; Operating on aa with Max[] w.r.t. the second index should yield {13,23}. Numerical example (3D): aaa = {{{111, 112, 113, 114}, {121, 122, 123, 124}, {131, 132, 133, 134}}, {{211, 212, 213, 214}, {221, 222, 223, 224}, {231, 232, 233, 234}}} Again, operating on aa with Max[] w.r.t. the second index should yield {{131, 132, 133, 134}, {231, 232, 233, 234}}. A way of doing (which I think is correct) is as follows: MaxInDim[list_, maxdim_] := Module[ {dims = Length[Dimensions[list]], dimList}, dimList = Insert[Range[dims - 1], dims, maxdim]; Apply[Max, Transpose[list, dimList], {dims - 1}] ] It seems to work, but if there is a general way of doing this I could maybe avoid having to construct similar versions for other common operations. TIA for any ideas about this! Pointers to info on Matlab->Mathematica syntax conversions would also be welcome. Ciao, Martin ==== AFAIK, there is no core tool to do this. There may be a package tool, but the following will do it using core tools only: Map[Max,Transpose[aaa,{1,3,2}],{2}] The basic idea is to transpose the matrix so the dimension to operate on is last, and the Map the operator down to that level. Here is a generalization which I have not tested well, but it seems to work: atIndex[operator_, data_, i_Integer] := With[{n = Depth[data]-1}, With[{ii = Append[Drop[Range[n],{i}],i]}, Map[operator, Transpose[data, ii], {n-1}] ]] in terms which we can write atIndex[Max, aaa, 2] to get your result below. I hope this helps a little. Don't know much about Matlab, except to warn you about vectors. Mathematica adheres to the physical definition of a vector, whereas Matlab, as I recall, uses row vectors and column vectors, which are really row matrices and column matrices. In Mathematica: vector: {a, b, c} row matrix: {{a, b, c}} column matrix: {{a}, {b}, {c}} Numerical example (3D): aaa = > {{{111, 112, 113, 114}, {121, 122, 123, 124}, {131, 132, 133, 134}}, > {{211, 212, 213, 214}, {221, 222, 223, 224}, {231, 232, 233, 234}}} Again, operating on aa with Max[] w.r.t. the second > index should yield {{131, 132, 133, 134}, {231, 232, 233, 234}}. Thomas E Burton 760/436-7436 353 Sanford Street, Encinitas, CA 92024-1508 ==== > -----Original Message----- > Sent: Thursday, March 21, 2002 3:27 PM > To: mathgroup@smc.vnet.net coming from the matlab world, I am used to operating > on subgroups of elements in arbitrary dimensions of > multidimensional matrices. An example of such an > operation would be the calculation of the maximum > value over all elements in a particular dimension, > i.e. apply max() on all elements in the desired > dimension for all index combinations in the remaining > dimensions, resulting in matrix with one less > dimension than the original matrix. Is there a neat (built-in) way to do this in > Mathematica? Numerical example (2D): aa = {{11,12,13},{21,22,23}}; Operating on aa with Max[] w.r.t. the second > index should yield {13,23}. > Numerical example (3D): aaa = > {{{111, 112, 113, 114}, {121, 122, 123, 124}, {131, 132, 133, 134}}, > {{211, 212, 213, 214}, {221, 222, 223, 224}, {231, 232, 233, 234}}} Again, operating on aa with Max[] w.r.t. the second > index should yield {{131, 132, 133, 134}, {231, 232, 233, 234}}. > A way of doing (which I think is correct) is as > follows: MaxInDim[list_, maxdim_] := > Module[ > {dims = Length[Dimensions[list]], > dimList}, > dimList = Insert[Range[dims - 1], dims, maxdim]; > Apply[Max, Transpose[list, dimList], {dims - 1}] > ] It seems to work, but if there is a general way of > doing this I could maybe avoid having to construct > similar versions for other common operations. TIA for any ideas about this! Pointers to info on > Matlab->Mathematica syntax conversions would > also be welcome. Ciao, Martin > Martin, what do you mean by a general way? All you need to do, is to abstract Max to an arbitrary function! To test for correctness (and to find a solution), it is useful to select a reasonable general test case: In[85]:= SeedRandom[0] In[86]:= m = Table[Random[Integer, {0, 1000}], {i, 3}, {j, 4}, {k, 2}, {l, 3}] Mostly it is of advantage to define a simple, albeit not performant, function to check the results. So applying a function f to all elements of the second index, say, is done by In[99]:= Table[f @@ m[[i, All, k, l]], {i, 3}, {k, 2}, {l, 3}] and substituting Max for f: In[100]:= % /. f -> Max Out[100]= {{{703, 984, 710}, {913, 652, 934}}, {{981, 512, 777}, {853, 922, 831}}, {{773, 993, 802}, {901, 728, 772}}} This is simple and clear. We can automate this method, if we can Table with a variable number of iterators. There has been a recent post on this theme. Using my answer from that, we get at: In[104]:= ApplyAtIndex0[f_Symbol | f_Function, m_, (index_Integer)?Positive] /; index <= (rank = TensorRank[m]) := With[{dims = Dimensions[m]}, Table @@ ({Unevaluated[f @@ Table[ m[[Sequence@@([Iota][#1]&)/@Range[rank]]], {[Iota][index], dims[[index]]}]], ##1}&)@@ ({[Iota][#1], dims[[#1]]}&)/@ Delete[Range[rank],index]] This is not so horrible as it seems to be: every [Iota][i], for i = 1,..,rank is an iterator variable. These are brought as indices to the matrix m. The inner Table iterates the index in question, the outer Table all other indices. The function is held until it comes to the outer Table. This however is nothing to be content with. You already found by yourself an (to my opinion) perfect solution (here in my words): In[114]:= ApplyAtIndex[(f_Symbol | f_Function), m_, index_Integer?Positive] /; index <= (rank = TensorRank[m]) := Module[{levels = Insert[Range[rank - 1], rank, index]}, Apply[f, Transpose[m, levels], {rank - 1}]] In[134]:= x2 = ApplyAtIndex[Max, m, 2] Out[134]= {{{703, 984, 710}, {913, 652, 934}}, {{981, 512, 777}, {853, 922, 831}}, {{773, 993, 802}, {901, 728, 772}}} There is a similar (dual) solution with MapThread: In[159]:= ApplyAtIndex2[(f_Symbol | f_Function), m_, index_Integer?Positive] /; index <= (rank = TensorRank[m]) := Module[{levels = Insert[Range[2, rank], 1, index]}, MapThread[f, Transpose[m, levels], rank - 1]] See how nicely they correspond. Finally I found still another solution: In[191]:= ApplyAtIndex3[(f_Symbol | f_Function), m_, index_Integer?Positive] /; index <= (rank = TensorRank[m]) := Map[MapThread[f, #, rank - index] &, m, {index - 1}] This is the shortest expression. In performance all functions (except for the Table solution) should come close, I guess your solution to be fastest, I didn't test however. We show the equivalence of all solutions: In[239]:= SameQ @@ Through[{ApplyAtIndex0, ApplyAtIndex, ApplyAtIndex2, ApplyAtIndex3}[ f, m, #]] & /@ Range[4] Out[239]= {True, True, True, True} It is an interesting question, whether such a function is needed, or better say, whether you will need it any longer after having adapted to Mathematica style. -- Hartmut Wolf ==== Dear Group, equations as a function of a parameter of the equations b. Problem is, there are multiple solution sets and my graph does not show which x goes with which y at a given b. How can I make such a graph? Details: In my problem, I have three equations in three unknowns x, y, and z. b is a parameter in these equations. Using NSolve, I built a function which takes b as a variable and returns the values of x, y, and z, like this; soln[b_]:=NSolve[{eqns},{x,y,z}] This is all good. My equations are rational, and NSolve returns at most three solutions sets {x,y,z} for any given b. Now, I want to plot x and y vs. b, on the same graph. I want the graph to show every solution set for each b. I tried: Show[{ ListPlot[ Flatten[ Table[Table[{i, x/.soln[i][[n]]]}, {i,1,10,.2}],{n, 1, 3}], 1], PlotStyle -> {PointSize[ .02], RGBColor[1, 0, 0]}, DisplayFunction -> Identity], ListPlot[ Flatten[ Table[Table[{i, y/.soln[i][[n]]]}, {i,1,10,.2}],{n, 1, 3}], 1], PlotStyle -> {PointSize[ .02], RGBColor[0, 1, 0]}, DisplayFunction -> Identity]}, DisplayFunction -> $DisplayFunction] which worked and a output a graph. Problem is, since there are three solutions, there are three distinct red (x) and three distinct green (y) points for every b. There is no way of knowing which x goes with which y from this graph. How can I make a graph which preserves this information? It is not as important to me to keep to color difference in x and y as it is to distinguish solution 1 from solution 2 from solution 3...but is there an easy way to do both in the same graph? -- Curt Fischer crf3@po.cwru.edu ==== Dear Group, equations as a function of a parameter of the equations b. Problem > is, there are multiple solution sets and my graph does not show which > x goes with which y at a given b. How can I make such a graph? Details: > In my problem, I have three equations in three unknowns x, y, and z. > b is a parameter in these equations. Using NSolve, I built a function > which takes b as a variable and returns the values of x, y, and z, > like this; soln[b_]:=NSolve[{eqns},{x,y,z}] This is all good. My equations are rational, and NSolve returns at > most three solutions sets {x,y,z} for any given b. Now, I want to plot x and y vs. b, on the same graph. I want the > graph to show every solution set for each b. I tried: Show[{ > ListPlot[ > Flatten[ > Table[Table[{i, x/.soln[i][[n]]]}, {i,1,10,.2}],{n, 1, 3}], > 1], > PlotStyle -> {PointSize[ .02], RGBColor[1, 0, 0]}, > DisplayFunction -> Identity], > ListPlot[ > Flatten[ > Table[Table[{i, y/.soln[i][[n]]]}, {i,1,10,.2}],{n, 1, 3}], > 1], > PlotStyle -> {PointSize[ .02], RGBColor[0, 1, 0]}, > DisplayFunction -> Identity]}, > DisplayFunction -> $DisplayFunction] which worked and a output a graph. Problem is, since there are three > solutions, there are three distinct red (x) and three distinct green > (y) points for every b. There is no way of knowing which x goes with > which y from this graph. How can I make a graph which preserves this information? It is not as > important to me to keep to color difference in x and y as it is to > distinguish solution 1 from solution 2 from solution 3...but is there > an easy way to do both in the same graph? > Curt Fischer > crf3@po.cwru.edu I'll show a basic example using two equations in two variables. There are two approaches that come to mind. One is to pick at each new b value, for a successor to a given solution at the previous value, the one that is closest to that previous solution. This will work fine until you get near b-values where solution paths cross. An alternative is to solve for a given initial value of b, convert to a system of ODEs with b as independent value, and give as separate initial solutions the solutions for the initial b value. This is what is done below. I think Carl Woll has posted variations of this in the past (but if it does not work for your purposes you should probably blame me and not him). eqns = {1+3*x[b]-7*x[b]*y[b]+b*x[b]*y[b]^2-x[b]^2, 4-2*x[b]+b^2/3*y[b]-y[b]^2} In[34]:= initsoln = NSolve[eqns /. b->3, {x[3],y[3]}] Out[34]= {{x[3] -> -0.0428556, y[3] -> 4.01708}, {x[3] -> 2.83817, y[3] -> 2.25741}, {x[3] -> -0.074289, y[3] -> -1.02954}, {x[3] -> 2.25857, y[3] -> 0.183619}} odes = D[eqns /. {x->x[b],y->y[b]}, b] sol1 = First[NDSolve[Join[Thread[odes==0], Thread[{x[3],y[3]} == ({x[3],y[3]}/.initsoln[[1]])]], {x[b], y[b]}, {b,3,6}]]; Now you can plot the solution over b in the range for which we solved: ParametricPlot[Evaluate[{x[b], y[b]} /. sol1], {b,3,6}] Similarly you can get plots for solutions using the other three initial values, e.g. sol2 = First[NDSolve[Join[Thread[odes==0], Thread[{x[3],y[3]} == ({x[3],y[3]}/.initsoln[[2]])]], {x[b], y[b]}, {b,3,6}]] ParametricPlot[Evaluate[{x[b], y[b]} /. sol2], {b,3,6}] One drawback to this approach is that you have to have some idea of how far you can continue a solution, in the parameter b, without it becoming complex-valued. Daniel Lichtblau Wolfram Research ==== solutions, there are three distinct red (x) and three distinct green > (y) points for every b. There is no way of knowing which x goes with > which y from this graph. How can I make a graph which preserves this information? It is not as > important to me to keep to color difference in x and y as it is to > distinguish solution 1 from solution 2 from solution 3...but is there > an easy way to do both in the same graph? Like a legend? You can find one in Graphics`Legend`. For your example, I suspect you'd be better off constructing a separate legend like ... lgnd = {Transpose[{legend_lines, legend_text}], LegendLabel->..., LegendOrientation->..., heaps of other options }; Then you can do something like ... a_plt = Show[your_stuff, DisplayFunction->Identity]; final_plot = ShowLegend[a_plt, lgnd, DisplayFunction->$DisplayFunction]; Dave. -------------------------------------------------------- Dr. David Annetts EM Modelling Analyst Tel: (+612) 9490 5416 CSIRO DEM, North Ryde Fax: (+612) 9490 5467 David.Annetts@csiro.au Include usual_disclaimers -------------------------------------------------------- ==== I'm programming quite alot with Mathematica for programming, in the field of engineering science. I would be interested to have a book to guide me a bit further. I'm looking for a good, somehow advanced Mathematica (4.0 or later) book, in particular focusing on programming with Mathematica, i.e. procedural, ruled, functional and object-oriented, accompanied by intuitive and illustrative examples. Could someone recommend: Roman E. Meader, Computer Science with Mathematica, Cambr. Univ. Press, 2000 ? Justus ==== yes, Meader is excelent. You should look for: David Wagner, Power Programming with Mathematica, The Kernel Jens > I'm programming quite alot with Mathematica for programming, in the > field of engineering science. I would be interested to have a book to > guide me a bit further. I'm looking for a good, somehow advanced > Mathematica (4.0 or later) book, in particular focusing on programming > with Mathematica, i.e. procedural, ruled, functional and > object-oriented, accompanied by intuitive and illustrative examples. Could someone recommend: Roman E. Meader, Computer Science with > Mathematica, Cambr. Univ. Press, 2000 ? Justus ==== Awer, What do you want to draw? Can you describe your problem better? > However our Any advise is greatly appreciated. ==== Mike, Just a normal scatter plot ... unemployment figures should be plotted against GPD figures (also with respect to years). Awer > Awer, What do you want to draw? Can you describe your problem better? > However our > Any advise is greatly appreciated. ==== What option should I use with the Plot command in order to obtain arrows > for x's and y's. > I mean: I want axes to be ended with arrows. Help me please. :) Mateusz > You could use the following: ----------------8<----------------8<---------------- PfeileAnAchsen::usage= PfeileAnAchsen[graphic] nimmt eine 2D-Graphik `graphic' und setzt Pfeile an das Ende der Achsen. Falls die Originalgraphik keine Achsen besitzt, werden welche erzeugt.n PfeileAnAchsen[graphic, frac] setzt die Länge der Pfeile auf den Bruchteil `frac' der Länge der Achsen und hängt sie an die Achsen an. Defaultwert für `frac' ist 1/15.n PfeileAnAchsen[graphik, frac, opts] erlaubt Optionen für die Pfeile mitzugeben. Diese Optionen sind Optionen von `Arrow'. Default ist HeadCenter->0.7 und HeadWidth->0.32. Options[PfeileAnAchsen]=Options[Arrow]; SetOptions[PfeileAnAchsen,HeadCenter->0.7,HeadWidth->0.32]; PfeileAnAchsen::whoops= Das erste Argument von `PfeileAnAchsen' muss eine 2D-Graphik mit Head Graphics sein. PfeileAnAchsen[pl_,(frac:(_?NumberQ):1/15),opts___?OptionQ]/; Head[pl]===Graphics||Message[ToArrowAxes::whoops]:= Module[{x0,y0,xi,xf,yi,yf,xdelta,ydelta,xfarrow,yfarrow,prim,gopts,hcopt}, hcopt=HeadCenter/.{opts}/.Options[PfeileAnAchsen]; {{xi,xf},{yi,yf}}=PlotRange/.AbsoluteOptions[pl,PlotRange]; {x0,y0}=AxesOrigin/.AbsoluteOptions[pl,AxesOrigin]; xdelta=(xf-xi)frac; ydelta=(yf-yi)frac;; xfarrow=Arrow[{xf,y0}, {xf+xdelta,y0},HeadCenter->hcopt,opts]; yfarrow=Arrow[{x0,yf}, {x0,yf+ydelta},HeadCenter->hcopt,opts]; Show[ Graphics[{xfarrow,yfarrow}, PlotRange->{{xi,xf+xdelta},{yi,yf+ydelta}}], FullGraphics[ pl/.Graphics[prim:{___},gopts_]:> Graphics[prim,Axes->True,gopts]], DisplayFunction->$DisplayFunction] ]; ----------------8<----------------8<---------------- Sorry for the german. Then all you have to do ist e.g. In[1]= pl=Plot[....] In[2]= PfeileAnAchsen[pl] you will need the Arrow-Package. Gruß Peter -- =--=--=--=--=--=--=--=--=--=--=--=--=--= http://home.t-online.de/home/phbrf Peter Breitfeld, Bad Saulgau, Germany Meinen GnuPG/PGP-5x Key gibts dort ==== Here is another one: ndig = 300; ngroup = 5; ncol = 4; sep=,; TableForm[ Partition[ Read[ StringToStream[ StringInsert[ StringDrop[ ToString[ N[Pi, ndig + 1] ], 2], sep, Table[i, {i, ngroup + 1, ndig, ngroup}] ] ], Table[Word, {ndig/ngroup}], WordSeparators -> {sep}], ncol ] ] MG there > are to this problem. I especially liked David Park's solution. I've got alot > to study to understand each of these. Jim ============================================================== > http://www.asar.com/cgi-bin/product.pl?58/hogwasher.html > ============================================================== ==== Absolutely right! I should have thought a little before answering. Tomas ----- Original Message ----- > Using NumberPadding, we have the following ... (excusing InputForm) In[107]:= > z = 12345 Out[107]= > 12345 In[115]:= > z1 =PaddedForm[z,8] Out[115]//PaddedForm= > 12345 In[111]:= > z2 = PaddedForm[z, 8, NumberPadding->{0, }] Out[111]//PaddedForm= > 000012345 In[116]:= > TableForm[{z, z1, z2}, TableAlignments->Right] Out[116]//TableForm= > !(* > InterpretationBox[GridBox[{ > {12345}, > { > TagBox[ > InterpretationBox[< 12345>, > 12345, > Editable->False], > (PaddedForm[ #, 8]&)]}, > { > TagBox[ > InterpretationBox[<000012345>, > 12345, > Editable->False], > (PaddedForm[ #, 8, NumberPadding -> {0, }]&)]} > }, > RowSpacings->1, > ColumnSpacings->3, > RowAlignments->Baseline, > ColumnAlignments->{Right}], > TableForm[ {12345, > PaddedForm[ 12345, 8], > PaddedForm[ 12345, 8, NumberPadding -> {0, }]}, TableAlignments - > Right]]) > Dave. > -------------------------------------------------------- > Dr. David Annetts EM Modelling Analyst > Tel: (+612) 9490 5416 CSIRO DEM, North Ryde > Fax: (+612) 9490 5467 David.Annetts@csiro.au > Include usual_disclaimers > -------------------------------------------------------- > ==== Dear Rob! Thank you for the explanation. (I didn't find this in help by myself). Thank you, Nikolay > According to the usage statement, NextComposition[l] gives the integer composition which follows l in a > canonical order. NextComposition takes a single list as its argument. For example, > NextComposition[{2,0,1}] returns {1,1,1}. Rob Pratt > Department of Operations Research > http://www.unc.edu/~rpratt/ ==== Is it possible to plot a vector (direction) field for a system of first order linear differential equations? I would like to visually display the stability/type of the solutions of several systems. How do I do this? I have tried several methods but none of them work. TIA, Ryan ==== what may the functions from Graphics`PlotField` do ? Jens > Is it possible to plot a vector (direction) field for a system of > first order linear differential equations? I would like to visually > display the stability/type of the solutions of several systems. How do > I do this? I have tried several methods but none of them work. TIA, > Ryan ==== Mathematica can't render non-convex polygons in 3d ! You can triangulate the polygon by hand if you have only one or you can use http://library.wolfram.com/packages/polygontriangulation/ Jens When I plot the following Graphics3D[{LightBlue, > Polygon[{{1,0,0},{1,0,1},{-1,0,1},{-1,0,0},{-1/2,0,0},{-1/2,0, > 1/2},{1/2,0,1/2},{1/2,0,0},{1,0,0}}]}],Lighting->False, > Boxed->False]; I get just a blue rectangle with some of the boundary drawn, not an inverted > U shape. Can someone explain this please. Kevin ==== > -----Original Message----- > Sent: Wednesday, March 20, 2002 7:53 AM > To: mathgroup@smc.vnet.net > When I plot the following Graphics3D[{LightBlue, > Polygon[{{1,0,0},{1,0,1},{-1,0,1},{-1,0,0},{-1/2,0,0},{-1/2,0, > 1/2},{1/2,0,1/2},{1/2,0,0},{1,0,0}}]}],Lighting->False, > Boxed->False]; I get just a blue rectangle with some of the boundary drawn, > not an inverted > U shape. Can someone explain this please. Kevin > Kevin, this is a problem frequently occurring, and you'll certainly find much on this in the archive. For reasons of algorithmic efficiency, Mathematica can correctly draw only those (flat) Polygons in 3D, which are star-shaped with respect to its first point (e.g. all convex polygons do have this property). So the simplest way to get your display right is to break your polygon into convex ones. Calling your polygon above p0, then with p0seg = Polygon[p0[[1, #]]] & /@ {{7, 8, 1, 2}, {2, 3, 6, 7}, {3, 4, 5, 6}} Show[Graphics3D[{{Hue[.45, .2, 1], EdgeForm[], p0seg}, Line @@ p0}], Lighting -> False, Boxed -> False] gives a correct display. To break up the polygons by program is a nice exercise, not trivial though. I recently made a quick hack, which works fine, but is not for publication (it's O[n^2], I think there are O[n log n] algorithms). You certainly will find something in the MathGroup archive (by Martin Kraus, if I remember right). Otherwise consult a text on algorithmic geometry. BTW a Delaunay triangulation will not do it (but you may fix it up). -- Hartmut Wolf P.S. yes, look for Martin Kraus' contribution at http://library.wolfram.com/mathgroup/archive/2000/Feb/msg00388.html ==== > Graphics3D[{LightBlue, > Polygon[{{1,0,0},{1,0,1},{-1,0,1},{-1,0,0},{-1/2,0,0},{-1/2,0, > 1/2},{1/2,0,1/2},{1/2,0,0},{1,0,0}}]}],Lighting->False, > Boxed->False]; You forgot Show[ and what LightBlue is Try braking it up into 3 convex polygons. have fun, SteveC steve@fractalus.com fractalus.com/steve ==== < False, Boxed -> False ] ],{w,1,1000}] >When I plot the following Graphics3D[{LightBlue, > Polygon[{{1,0,0},{1,0,1},{-1,0,1},{-1,0,0},{-1/2,0,0},{-1/2,0, > 1/2},{1/2,0,1/2},{1/2,0,0},{1,0,0}}]}],Lighting->False, > Boxed->False]; I get just a blue rectangle with some of the boundary drawn, not an inverted >U shape. Can someone explain this please. Kevin ==== Variants of your question have appeared before in the mathgroup and a look though the archives will show you that it has annoyed customers for a long time. PolygonTriangulation from http://library.wolfram.com/packages/ that provides a work-around to this feature. This plots your nonconvex polygon as expected. It sure would be nicer if mathematica did this without having to resort to an addon package. Needs[PolygonTriangulation`SimplePolygonTriangulation`]; Show[TriangulateSimplePolygons3D[Graphics3D[Polygon[ {{1,0,0},{1,0,1},{-1,0,1},{-1,0,0},{-1/2,0,0}, {-1/2,0,1/2},{1/2,0,1/2},{1/2,0,0},{1,0,0}}]]]]; -- Dr. Christopher J. Purcell Defence Research Establishment Atlantic 9 Grove St., PO Box 1012, Dartmouth, NS Canada B2Y 3Z7 Tel: 902-426-3100-x389 Fax: 902-426-9654 E-mail: purcell@drea.dnd.ca ==== Kevin, When showing a Polygon[{p1,p2,p3,p4,...pn}] in 3D, Mathematica superimposes the insides of the triangles Polygon[{p1,p2,p3}], Polygon[{p1,p3,p4}, ....,Polygon[{p1, p(n-1), pn}] This accounts for the solid rectangle that you get. How it decides on the edges, or parts of the edges, to show, I have not yet worked out in detail but it looks to be based on parts of the line Line[{p1,p2,p3,...,pn}]. -- 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 Fax: +44 (0)870 164 0565 > When I plot the following Graphics3D[{LightBlue, > Polygon[{{1,0,0},{1,0,1},{-1,0,1},{-1,0,0},{-1/2,0,0},{-1/2,0, > 1/2},{1/2,0,1/2},{1/2,0,0},{1,0,0}}]}],Lighting->False, > Boxed->False]; I get just a blue rectangle with some of the boundary drawn, not an inverted > U shape. Can someone explain this please. Kevin > ==== TestLog, TestMake, TestRun; I'm Drew Harrison of Agilent, and I'm new to Mathematica. I'm trying to set up QA tests for the module functions in a rather large application our research team has developed using Mathematica. I have downloaded the internal testing software from the Mathematica developer site. Right now, it's a lot less than clear, what I need to do to make a test using these tools. Most of Wolframs documentation on the subject is too vague for my current needs, and almost all of it talks about testing the Kernel. I need to test my application modules. I've searched the Mathematica site and several other related sites with no success. Can anyone out there help me understand how to use their QA test tools? I'm looking for; examples of test scripts, or references to websites where they might be found or more complete documentation or notes on how to use these tools Help? Drew_Harrison@Agilent.com ==== > -----Original Message----- > Sent: Wednesday, March 20, 2002 7:53 AM > To: mathgroup@smc.vnet.net > Can anyone see an easy way of putting a fiven list of n^2 > integers into an > n*n matrix along the diagonals---could be either not-snaking > (preferred) > snaking. The *ordering*, but not necessarily the integers > themselves, would > be 1 3 6 > 2 5 8 > 4 7 9 I would call this non-snaking, or the following, snaking. 1 2 6 > 3 5 7 > 4 8 9 Please note,. It occurred to me that this might be possible by first > partitioning into > ascending and descending size lists representing each > diagonal, but aside > from constructing an explicit secondary matrix of indices, I can't see > another way of doing it. Cheers, Mark > -- > Mark R. Diamond > No crawler web page ROT13 uggc://jjj.cfl.hjn.rqh.nh/hfre/znexq Mark, generate a matrix of indices to cast your data into the appropriate form. Define n=7; hatchx= With[{zzz = Rest[FoldList[Plus,0,Range[2*n]]]- Join[Table[0,{n}], Rest[FoldList[Plus,0,2*Range[n]-1]]]}, (Take[zzz,{1,n}+#]-#&)/@Range[0,n-1]] {{ 1, 3, 6,10,15,21,28}, { 2, 5, 9,14,20,27,34}, { 4, 8,13,19,26,33,39}, { 7,12,18,25,32,38,43}, {11,17,24,31,37,42,46}, {16,23,30,36,41,45,48}, {22,29,35,40,44,47,49}} Then bring your list of data, e.g. m=Array[a,{n^2}]; (m[[#]]&)/@hatchx //MatrixForm to the hatched form. If you prefer the snakes, generate different indices: (snakex = MapIndexed[ If[(-1)^(Plus @@ #2) === 1, #1, hatchx[[Sequence@@Reverse[#2] ]] ] &, hatchx, {2}]) // MatrixForm A different, more straightforward variant based on list processing would be: hatchx = Module[ {r = Rest[FoldList[{#1[[2]]+1,#1[[2]]+#2}&,{0,0},Range[n]]], rr, rawx}, rr = -Reverse /@ Rest[Reverse[r]]; rawx = Join[ (PadLeft[Take[Range[n^2], #1], n]&) /@ r, (PadRight[Take[Range[n^2], #1], n]&) /@ rr]; rawx[[#1 - 1 + Range[n],-#1]]& /@ Range[n] ] snakex = Module[ {r = Rest[FoldList[{#1[[2]]+1,#1[[2]]+#2}&,{0, 0},Range[n]]], rr, rawx}, rr = (-1)*Reverse /@ Rest[Reverse[r]]; rawx = Join[ MapIndexed[PadLeft[ If[(-1)^(#2[[1]]-1) === 1, Identity, Reverse][Take[Range[n^2], #1]], n] &, r], MapIndexed[PadRight[ If[(-1)^#2[[1]] === 1, Identity, Reverse][Take[Range[n^2], #1]], n] &, rr]]; rawx[[#1 - 1 + Range[n], -#1]]& /@ Range[n] ] -- Hartmut ==== Mark, Here is the code I arrived at: wrapsquarematrix[lst_List, x_Integer] /; Length[lst] >= x^2 := Module[{a, n = 0}, a = Table[0, {x}, {x}]; Do[a[[i, j - i + 1]] = lst[[++n]], {j, 1, x}, {i, 1, j}]; Do[a[[i + j, x - i + 1]] = lst[[++n]], {j, 1, x - 1}, {i, 1, x - j}]; a ] It is non-snaking per your definision. If it wraps the wrong way, just use Transpose. If you want a more robust function that can produce rectangular matricies, let me know. Paul ==== Mark: Here is a non-snaking solution, but it looks sort of like what you describe. In[1]:= data[n_] := Range[n^2] In[2]:= order[n_] := Sort[Flatten[Outer[List, Range[n], Range[n]], 1], Plus @@ #1 <= Plus @@ #2 & ]; In[3]:= Transpose[{order[4],data[4]}]//Sort[#,(First[First[#1]]?First[First[#2]])&]& //Transpose//Last//Partition[#,4]& Out[3]= {{1, 2, 4, 7}, {3, 5, 8, 11}, {6, 9, 12, 14}, {10, 13, 15, 16}} Ken Levasseur UMass Lowell > Can anyone see an easy way of putting a fiven list of n^2 integers into an > n*n matrix along the diagonals---could be either not-snaking (preferred) > snaking. The *ordering*, but not necessarily the integers themselves, would > be 1 3 6 > 2 5 8 > 4 7 9 I would call this non-snaking, or the following, snaking. 1 2 6 > 3 5 7 > 4 8 9 Please note,. It occurred to me that this might be possible by first partitioning into > ascending and descending size lists representing each diagonal, but aside > from constructing an explicit secondary matrix of indices, I can't see > another way of doing it. Cheers, Mark > -- > Mark R. Diamond > No crawler web page ROT13 uggc://jjj.cfl.hjn.rqh.nh/hfre/znexq ==== I'm trying to do a memory-sensitive calculation using Mathematica 4.1.5 on Mac OS 10.1.3. It appears that in OS X the Math Kernel is hidden from view. So, is it possible to do the calculation in the Kernel *without* also running the front end? ==== A particular calculation produces at an early stage the intermediate result p1 = (Sin[x]/x) + (Sinh[y]/y) , (x and y both real) and this result then feeds into further expressions in a lengthy symbolic calculation. When I try to do any numerical evaluations of the final expressions with either x or y = 0, I get Indeterminate expression or infinity 1/0 error messages, even though the expressions themselves, like the expression above, are perfectly determinate and finite for those limits. Any simple way to make this expression behave as it should under numerical evaluation? ==== > A particular calculation produces at an early stage the intermediate > result p1 = (Sin[x]/x) + (Sinh[y]/y) , (x and y both real) and this result then feeds into further expressions in a lengthy symbolic > calculation. When I try to do any numerical evaluations of the final expressions with > either x or y = 0, I get Indeterminate expression or infinity 1/0 > error messages, even though the expressions themselves, like the > expression above, are perfectly determinate and finite for those limits. The expressions themselves are normally considered to be undefined at 0. OTOH, as their arguments approach 0, their _limits_ are indeed perfectly determinate and finite. You should not expect a function's value (or lack thereof) _at_ x = c to be related to the limit of that function as x _approaches_ c. > Any simple way to make this expression behave as it should under > numerical evaluation? AFAIK, there is no way to do what you want. And, in my opinion, what you want to be done under numerical evaluation is not what should be done. Can you reasonably well work with the limits of the expressions, rather than their simple numerical evaluations? David Cantrell -- ==== You have to use Limit when you want to take a limit, Mathematica won't immidiatly do this for you. Limit[(Sinh[y]/y), y -> 0] > A particular calculation produces at an early stage the intermediate result p1 = (Sin[x]/x) + (Sinh[y]/y) , (x and y both real) and this result then feeds into further expressions in a lengthy symbolic > calculation. When I try to do any numerical evaluations of the final expressions with either > x or y = 0, I get Indeterminate expression or infinity 1/0 error messages, > even though the expressions themselves, like the expression above, are perfectly > determinate and finite for those limits. Any simple way to make this expression behave as it should under numerical > evaluation? > ==== A particular calculation produces at an early stage the intermediate result p1 = (Sin[x]/x) + (Sinh[y]/y) , (x and y both real) and this result then feeds into further expressions in a lengthy symbolic > calculation. When I try to do any numerical evaluations of the final expressions with either > x or y = 0, I get Indeterminate expression or infinity 1/0 error messages, > even though the expressions themselves, like the expression above, are perfectly > determinate and finite for those limits. Any simple way to make this expression behave as it should under numerical > evaluation? Look here Normal[Series[(Sin[x]/x) + (Sinh[y]/y), {x, 0, 4}, {y, 0, 4}]] for a series approximation Ciao -erk- ==== How do I get Mathematica 2.2 to count the derivatives of the simplest parametric functions, i.e. (ax)', where a is the parameter and x is the variable. I want to get: a (Hey, I said it was stupid). D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out how to use Constants and NonConstants. I'd be grateful for any help as this simple problem is driving me crazy. -- Jacek Kie³czewski kielczew@poczta.onet.pl ==== you forgot a space between a and x D[a x,x] gives a Dt[a x,x] gives a+x D[a,x] as it should. Jens How do I get Mathematica 2.2 to count the derivatives of the simplest > parametric functions, i.e. (ax)', where a is the parameter and x is the variable. I want to get: a (Hey, I said it was stupid). D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out > how to use Constants and NonConstants. I'd be grateful for any help as > this simple problem is driving me crazy. -- > Jacek Kie³czewski > kielczew@poczta.onet.pl ==== Are you sure you're leaving a space between the a and the x in a x? If you aren't, then ax is a symbol, an unknown symbol, and that is why you're getting those answers: In[1]:= D[ax, x] Out[1]= 0 In[2]:= D[a*x, x] Out[2]= a In[3]:= Dt[ax, x] Out[3]= Dt[ax, x] In[4]:= Dt[a*x, x] Out[4]= a + x*Dt[a, x] Tomas Garza Mexico City ----- Original Message ----- D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out > how to use Constants and NonConstants. I'd be grateful for any help as > this simple problem is driving me crazy. > -- > Jacek Kie³czewski > kielczew@poczta.onet.pl > ==== > How do I get Mathematica 2.2 to count the derivatives of the simplest > parametric functions, i.e. (ax)', where a is the parameter and x is the variable. I want to get: a (Hey, I said it was stupid). D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out > how to use Constants and NonConstants. I'd be grateful for any help as > this simple problem is driving me crazy. HI! don't forget that ax is a new symbol...you mean for sure a*x..... D[a*x,x]=a try.....and never forget..a*x is NOT!!! ax be careful and good work ==== Clear[a,x] D[a*x, x] yields a. Using * for multiplication is always highly advisible. Matthias Bode Sal. Oppenheim jr. & Cie. KGaA Koenigsberger Strasse 29 D-60487 Frankfurt am Main GERMANY Tel.: +49(0)69 71 34 53 80 Mobile: +49(0)172 6 74 95 77 Fax: +49(0)69 71 34 95 380 E-mail: matthias.bode@oppenheim.de Internet: http://www.oppenheim.de -----UrsprÃ.b9ngliche Nachricht----- Von: Jack [mailto:kielczew@poczta.onet.pl] Gesendet: Donnerstag, 21. März 2002 15:27 An: mathgroup@smc.vnet.net Betreff: Stupid simple question about counting derivatives How do I get Mathematica 2.2 to count the derivatives of the simplest parametric functions, i.e. (ax)', where a is the parameter and x is the variable. I want to get: a (Hey, I said it was stupid). D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out how to use Constants and NonConstants. I'd be grateful for any help as this simple problem is driving me crazy. -- Jacek Kieczewski kielczew@poczta.onet.pl ==== Jack: ax is one symbol, a*x and a x stand for the product of a and x. -- 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 Fax: +44 (0)870 164 0565 > How do I get Mathematica 2.2 to count the derivatives of the simplest > parametric functions, i.e. (ax)', where a is the parameter and x is the variable. I want to get: a (Hey, I said it was stupid). D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out > how to use Constants and NonConstants. I'd be grateful for any help as > this simple problem is driving me crazy. > -- > Jacek Kie³czewski > kielczew@poczta.onet.pl > ==== D[a x,x] You need a space between the a and the x. What you have now is a variable ax, and since D takes the partial derivative w.r.t x, and ax is an unrelated variable, D returns 0. with the space, (a x) is the same as a*x. -- Avraham Shinnar > How do I get Mathematica 2.2 to count the derivatives of the simplest > parametric functions, i.e. (ax)', where a is the parameter and x is the variable. I want to get: a (Hey, I said it was stupid). D[ax,x] gets me 0, Dt[ax,x] gets me Dt[ax,x] and I haven't figured out > how to use Constants and NonConstants. I'd be grateful for any help as > this simple problem is driving me crazy. > -- > Jacek Kie³czewski > kielczew@poczta.onet.pl > ==== Mark, I've been using Tr[x] as an alternative to Apply[Plus, x] for long time. Though I can't conclusively explain why it's faster in your application, I'm pretty sure it's related to the handling of packed arrays though. Try this little experiment: lst = Table[Random[], {1000000}]; Tr[lst] // Timing Plus @@ lst // Timing Tr[lst] // Timing Plus @@ lst // Timing way down, but most interestingly, Plus@@ actually becomes FASTER when working on the unpacked data, to the point that evaluation time is equal to or less than for Tr[lst] on the same unpacked data. Paul >>>>>>>>>>>>>>>>>> In the course of working on an optimization problem that involves summing large lists of real numbers, a colleague of mine came across an interesting result. We compared the computational speed of different methods for summing lists: (1) Apply[Plus, mylist] (2) Dot[mylist,ListofOnes], where ListofOnes is a list of of size N of 1.0's (3) Tr[mylist], where Tr is the built-in matrix trace operator. Based on our tests (where list sizes range from 100,000 to 1,000,000 elements), Method (3) is far and away the fastest. On average (3) is 5x faster than Method (2), and over 70x faster than Method (1). I was curious if anyone could offer an explanation. -Mark ==== ReadList is indeed the fastest. To correctly read a file on a Windows system you must change a DOSTextFormat option. The following shows how: strm=OpenRead[filename, DOSTextFormat->False]; data=ReadList[strm, Byte]; Close[strm]; Mariusz -- =============================== Mariusz Jankowski University of Southern Maine mjkcc@usm.maine.edu 207-780-5580 > The question: > What is the fastest way to read binary files in Mathematica 4.0 ? > I think the fastest is with ReadList (indeed ReadSounFile that use it, seems > to be better than BinaryImport), but when i use this command... > ....it doesn't read whole file; can somebody tell me the reason? Raf. P.S.: > I made some simple tests (@ 16 bit): << Experimental` > ByteOrdering -> -1]; => 10 seconds LeastSignificantByteFirst]; = > 26 seconds << Miscellaneous`Audio` ==== minpos = Compile[{{lst, _Real, 2}}, Module[{i = 1}, MapIndexed[If[First[#] < lst[[i, 1]], i = First[#2], 0] &, lst]; {{i, 1}} ] ] minpos[data] // Timing should be faster. Jens I have a list where each element is a list of three values > {{v11,v12,v13},{v21,v22,v23}...}. > What is the fastest method for finding the position and value of the > element which has the smallest first element. I have the following but is it possible to do this more quickly, perhaps > without two sorts through the data? In[1]:= Out[1]= > 4.1 for Microsoft Windows (June 13, 2001) In[2]:= > data=Table[{Random[],Random[]-0.5,10(Random[]-0.5)},{10000}]; In[3]:= > Timing[a=Min[Transpose[data][[1]]];p=Position[data,a];{a,p}] Out[3]= > {0.33 Second,{0.0000316723,{{1706,1}}}} I must also find the element which has the smallest second element greater > than zero. Here are my attempts so far. Is there a faster method? In[4]:= > Timing[a=Infinity;i=0; > While[i++;i {1.31 Second,{0.0000126855,1134}} In[5]:= > Timing[a=Min[Transpose[data][[2]]/.v_/;v[LessEqual] 0 [Rule] Infinity]; > p=Position[data,a];{a,p}] Out[5]= > {0.71 Second,{0.0000126855,{{1134,2}}}} In[6]:= > Timing[a=Min[Select[Transpose[data][[2]],#>0&]];p=Position[data,a];{a,p}] Out[6]= > {0.61 Second,{0.0000126855,{{1134,2}}}} Thank you for your ideas Hugh Goyder ==== >I have a list where each element is a list of three values >{{v11,v12,v13},{v21,v22,v23}...}. >What is the fastest method for finding the position and value of the >element which has the smallest first element. I have the following but is it possible to do this more quickly, perhaps >without two sorts through the data? >In[1]:= Out[1]= >4.1 for Microsoft Windows (June 13, 2001) In[2]:= >data=Table[{Random[],Random[]-0.5,10(Random[]-0.5)},{10000}]; In[3]:= >Timing[a=Min[Transpose[data][[1]]];p=Position[data,a];{a,p}] Out[3]= >{0.33 Second,{0.0000316723,{{1706,1}}}} >I must also find the element which has the smallest second element greater >than zero. Here are my attempts so far. Is there a faster method? In[4]:= >Timing[a=Infinity;i=0; > While[i++;i{1.31 Second,{0.0000126855,1134}} In[5]:= >Timing[a=Min[Transpose[data][[2]]/.v_/;v[LessEqual] 0 [Rule] Infinity]; > p=Position[data,a];{a,p}] Out[5]= >{0.71 Second,{0.0000126855,{{1134,2}}}} In[6]:= >Timing[a=Min[Select[Transpose[data][[2]],#>0&]];p=Position[data,a];{a,p}] Out[6]= >{0.61 Second,{0.0000126855,{{1134,2}}}} > 4.1 for Mac OS X (November 5, 2001) data= Table[{Random[],Random[]-0.5,10(Random[]-0.5)}, {50000}]; First problem Timing[a=Min[Transpose[data][[1]]]; p=Position[data,a];{a,p}] {0.3500000000000014*Second, {0.00001864319190335675, {{1017, 1}}}} Timing[a=Min[d=data[[All,1]]]; p=(Join[#,{1}]&/@Position[d,a]);{a,p}] {0.09999999999999432*Second, {0.00001864319190335675, {{1017, 1}}}} Second problem Timing[a=Min[Select[Transpose[data][[2]],#>0&]]; p=Position[data,a];{a,p}] {0.6600000000000037*Second, {4.325948545713665*^-6, {{44293, 2}}}} Timing[a=Min[Select[d=data[[All,2]],#>0&]]; p=(Join[#,{1}]&/@Position[d,a]);{a,p}] {0.4299999999999997*Second, {4.325948545713665*^-6, {{44293, 1}}}} Bob Hanlon Chantilly, VA USA ==== > -----Original Message----- > Sent: Wednesday, March 20, 2002 7:53 AM > To: mathgroup@smc.vnet.net > I have a list where each element is a list of three values > {{v11,v12,v13},{v21,v22,v23}...}. > What is the fastest method for finding the position and value of the > element which has the smallest first element. I have the following but is it possible to do this more > quickly, perhaps > without two sorts through the data? > In[1]:= Out[1]= > 4.1 for Microsoft Windows (June 13, 2001) In[2]:= > data=Table[{Random[],Random[]-0.5,10(Random[]-0.5)},{10000}]; In[3]:= > Timing[a=Min[Transpose[data][[1]]];p=Position[data,a];{a,p}] Out[3]= > {0.33 Second,{0.0000316723,{{1706,1}}}} > I must also find the element which has the smallest second > element greater > than zero. Here are my attempts so far. Is there a faster method? In[4]:= > Timing[a=Infinity;i=0; > > While[i++;i {1.31 Second,{0.0000126855,1134}} In[5]:= > Timing[a=Min[Transpose[data][[2]]/.v_/;v[LessEqual] 0 > [Rule] Infinity]; > p=Position[data,a];{a,p}] Out[5]= > {0.71 Second,{0.0000126855,{{1134,2}}}} In[6]:= > Timing[a=Min[Select[Transpose[data][[2]],#>0&]];p=Position[dat > a,a];{a,p}] Out[6]= > {0.61 Second,{0.0000126855,{{1134,2}}}} Thank you for your ideas Hugh Goyder > Hugh, on my machine In[1]:= SeedRandom[0] In[2]:= data = Table[{Random[], Random[] - 0.5, 10(Random[] - 0.5)}, {10000}]; your method: In[3]:= Timing[a = Min[Transpose[data][[1]]]; p = First /@ Position[data, a]; {a, p}] Out[3]= {0.4 Second, {0.0000418617, {9188}}} You may improve your idea a little bit: In[4]:= Timing[a = Min[b = Transpose[data][[1]]]; p = First /@ Position[b, a]; {a, p}] Out[4]= {0.12 Second, {0.0000418617, {9188}}} However (for this problem size!) it is more economic to use Ordering: In[6]:= Transpose[{#, data[[#]]} &@Ordering[b = Transpose[data][[1]], 1]] // Timing Out[6]= {0.01 Second, {{9188, {0.0000418617, -0.0110595, -1.11659}}}} For your second problem, your best method is In[19]:= Timing[a = Min[Select[Transpose[data][[2]], # > 0 &]]; p = Position[data, a]; {a, p}] Out[19]= {0.962 Second, {0.0000467033, {{1345, 2}}}} Same trick for (slight) improvement: In[24]:= Timing[a = Min[Select[b = Transpose[data][[2]], # > 0 &]]; p = Position[b, a]; {a, p}] Out[24]= {0.661 Second, {0.0000467033, {{1345}}}} Again Ordering may be used: In[26]:= {data[[#]], #} & /@ Ordering[Replace[Transpose[data][[2]], _?NonPositive -> Infinity, {1}], 1] // Timing Out[26]= {0.511 Second, {{{0.451783, 0.0000467033, -4.55627}, 1345}}} The time is used up with the replacement operation (or Select in your case). We search for a more efficient list operation. Now if your data are reasonably distributed around zero for their second component (as is in your example) we may do much faster: In[39]:= {data[[#]], #} &@ Catch[Scan[If[Positive[b[[#]]], Throw[#]] &, Ordering[Abs[b = Transpose[data][[2]]]]]] // Timing Out[39]= {0.07 Second, {{0.451783, 0.0000467033, -4.55627}, 1345}} If there is no positive element[[2]], the you'll get Null (the value of Scan). Please regard that all judgement is dependent on problem size: Transpose, Min and Position are essentially O[n]; methods involving Sort (as Ordering does) are O[n log n]. That they are better for this size is based on their efficient kernel implementation. -- Hartmut Wolf ==== Can someone point me the right direction on how to go about drawing vector diagrams in Mathematica or if it can be done at all. I would like to draw several vectors in a sphere. Specifically I want the xy plane as a shaded ellipse and the three axes, originating from the centre of the ellipse with the z-axis vertical along the page and y-axis, horizontally along the page. In this frame I then want to draw vectors from the origin to various points within this sphere. Yas ==== Mathematica has no nice 3d arrows but you may use the arrows from Needs[Graphics`PlotField3D`] Arrow[{x_, y_, z_}, {dx_, dy_, dz_}] := Graphics`PlotField3D`Private`vector3D[{x, y, z}, {dx, dy, dz}, True] and use poly = Polygon [ Table[{Cos[phi], Sin[phi], 0}, {phi, 0, 2Pi, 2Pi/20}]]; Show[Graphics3D[{poly, Arrow[{0, 0, 0}, {1, 0, 0}], Arrow[{0, 0, 0}, {0, 1, 0}], Arrow[{0, 0, 0}, {0, 0, 1}] } ] ] to make the axes and the ellipse. Jens Can someone point me the right direction on how to go about drawing > vector diagrams in Mathematica or if it can be done at all. I would like > to draw several vectors in a sphere. Specifically I want the xy plane as > a shaded ellipse and the three axes, originating from the centre of the > ellipse with the z-axis vertical along the page and y-axis, horizontally > along the page. In this frame I then want to draw vectors from the > origin to various points within this sphere. > Yas ==== There is no 3D equivalent of Arrow; however, I have written a small routine called Vector3D[{x1,y1,z1},{x2,y2,z2},HeadLength] that draws a line and an inverted cone for the head of the vector. It works, but I usually have to fiddle with the size of the cone through HeadLength to make it look right. If you would like, I will send it to you. Kevin > Can someone point me the right direction on how to go about drawing > vector diagrams in Mathematica or if it can be done at all. I would like > to draw several vectors in a sphere. Specifically I want the xy plane as > a shaded ellipse and the three axes, originating from the centre of the > ellipse with the z-axis vertical along the page and y-axis, horizontally > along the page. In this frame I then want to draw vectors from the > origin to various points within this sphere. > Yas ==== Could you please send me a copy of your routine for a 3D Arrow? Is it a package? Also, do you know of anything equivalent in MathSource? ....Terry > There is no 3D equivalent of Arrow; however, I have written a small routine > called Vector3D[{x1,y1,z1},{x2,y2,z2},HeadLength] that draws a line and an > inverted cone for the head of the vector. It works, but I usually have to > fiddle with the size of the cone through HeadLength to make it look right. > If you would like, I will send it to you. Kevin > Can someone point me the right direction on how to go about drawing > vector diagrams in Mathematica or if it can be done at all. I would like > to draw several vectors in a sphere. Specifically I want the xy plane as > a shaded ellipse and the three axes, originating from the centre of the > ellipse with the z-axis vertical along the page and y-axis, horizontally > along the page. In this frame I then want to draw vectors from the > origin to various points within this sphere. > Yas > ==== I was getting weird results today and reduced the code producing them to this: Clear[a,b,c] Simplify[5(a+a b-a(1+b))==0,{c>5}] False Surely that¹s not right?! Can anyone explain whats going on? Mat Bowen Department of Mathematics Loughborough University