Subject: RE : Building List Hello ! There are a lot of ways... For example : In[47]:= exemple = {{1, 2}, {3, 4, 5, 6}, {7, 8}, {9, 10, 11}}; In[52]:= Clear[f]; f[li_ /; Length[li] > 2] := ({First[li], #1} & ) /@ Drop[li, 1]; f[li_] := {li}; In[55]:= Flatten[f /@ exemple, 1] Out[55]= {{1, 2}, {3, 4}, {3, 5}, {3, 6}, {7, 8}, {9, 10}, {9, 11}} Meilleures salutations F.Jaccard -----Message d'origine----- DeÊ: Bruce W. Colletti [mailto:bcolletti@compuserve.com] ËÊ: mathgroup@smc.vnet.net ObjetÊ: Building List Re Mathematica 5.0.1.0. I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and want to replace element-lists (whose length exceeds 2) with another list built from that element. All else is untouched. For instance, using L above, replace {3,4,5,6} with {3,4}, {3,5}, {3,6}. This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, {7,8} }. Although I can do this using Sow and Reap, am hoping there's an easier way using rules (/.). In general, I want to replace those L-elements x (that meet a criterion) with foo[x]. Bruce === Subject: RE: Building List >-----Original Message----- === >Subject: Building List >Re Mathematica 5.0.1.0. >I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and >want to replace element-lists (whose length exceeds 2) with >another list >built from that element. All else is untouched. >For instance, using L above, replace {3,4,5,6} with {3,4}, >{3,5}, {3,6}. > This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, >{7,8} }. >Although I can do this using Sow and Reap, am hoping there's an easier >way using rules (/.). In general, I want to replace those >L-elements x >(that meet a criterion) with foo[x]. >Bruce If all your sublists are of even length, it's easy: In[1]:= l = {{1, 2}, {3, 4, 5, 6}, {7, 8}}; In[2]:= Partition[Flatten[l, 1], 2] Out[2]= {{1, 2}, {3, 4}, {5, 6}, {7, 8}} ...else, if you then drop the last elements: In[3]:= l2 = {{1, 2}, {3, 4, 5, 6, 6.5}, {7, 8}}; In[4]:= Flatten[#, 1] &[Partition[#, 2] & /@ l2] Out[4]= {{1, 2}, {3, 4}, {5, 6}, {7, 8}} ...or if you want to retain it (as singleton): In[5]:= Flatten[#, 1] &[Partition[#, 2, 2, {1, 1}, {}] & /@ l2] Out[5]= {{1, 2}, {3, 4}, {5, 6}, {6.5}, {7, 8}} ...or retain the first element as singleton: In[21]:= Flatten[#, 1] &[ Partition[#, 2, 2, {1 + Mod[Length[#], 2], 1}, {}] & /@ l2] Out[21]= {{1, 2}, {3}, {4, 5}, {6, 6.5}, {7, 8}} ...?? -- Hartmut Wolf === Subject: RE: Building List Bruce: Create a function to do what you wish, e.g. - fix[lst_]:=If[Length[lst]>2,Table[{lst[[1]],lst[[i]]},{i,2,Length[lst]}],lst ] Then map it to your list - fix /@ { {1,2},{3,4,5,6},{7,8} } It's better practice not to use capital letters, or initial caps, in defining your own variables or functions. That's because Mathematica, by default, uses capital letters and initial caps in defining its own variables and functions. 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 New York, N.Y. 10012-1074 -----Original Message----- === Subject: Building List Re Mathematica 5.0.1.0. I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and want to replace element-lists (whose length exceeds 2) with another list built from that element. All else is untouched. For instance, using L above, replace {3,4,5,6} with {3,4}, {3,5}, {3,6}. This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, {7,8} }. Although I can do this using Sow and Reap, am hoping there's an easier way using rules (/.). In general, I want to replace those L-elements x (that meet a criterion) with foo[x]. Bruce === Subject: Interpretation of subscripts I wanted to solve a differential equation via DSolve. When naming the constants with subscripts (e.g. for the mass of the sun M_Sun with the word Sun on the line), Mathematica 5 in some way misinterpreted this and told me: DSolve::bvfail : For some branches of the general solution, unable to solve the conditions. It works, when I leave out the subscripts and name the mass of the sun simply M and the mass of a planet m, but for optical reasons it would be nice to have subscripts for better understanding. I also tried this with Mathematica 4.2 in university - and it worked fine, but I only have version 5 in my office. In help files it is said, that Mathematica wouldn't interprete subscipts in any other way than as names, but obviously it does... Is there any point in preferences to tell the programm how it should handle these things? I'm grateful for any help Guido === Subject: Re: plot data points onto sphere Something like this? < surface of a sphere, generated with SphericalPlot3D. Does anyone know > how to do that with mathematica? There was a related entry from Peter > Lundberg, yet without response. > Michael === Subject: Re: plot data points onto sphere > surface of a sphere, generated with SphericalPlot3D. Does anyone know > how to do that with mathematica? There was a related entry from Peter > Lundberg, yet without response. This is a primitive way: Needs[Graphics`ParametricPlot3D] pic1 = SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2Pi}] data = Table[{ArcCos[Random[]*2 - 1], Random[]*2*Pi}, {100}]; fun1[{theta_, phi_}] := {Sin[theta]Cos[phi],Sin[theta]Sin[phi],Cos[theta]} pic2 = Graphics3D[{PointSize[0.05], Map[Point[fun1[#]]&, data]}] Show[pic1, pic2] You may get some funny graphical artefacts because of the way the points and the polygons of the sphere inter(lace?,vene?). Ways to avoid that would make another story. -- Sampo Smolander === Subject: Re: Matrix Inversion Gregor, If your matrix were badly conditioned, another system would probably also have trouble. Often the matrix merely needs rescaling. I use the following: scaledInverse[m_?MatrixQ] := With[{scale = MapIndexed[If[#2[[1]] == #2[[2]], 1/Sqrt[#1], 0] & , m, {2}]}, scale . Inverse[scale . m . scale] . scale ] Tom Burton === Subject: Drawing a globe, with countries and great circle routes I'd like to draw a globe (as seen from space) with countries and oceans (in color if possible), maybe even some topography; be able to overlay great circle routes between specified points; and then view the result from different points in space either by rotating the globe in 3D fashion or redrawing the image. Any Mathematica packages, freeware or commercial, that will do this? === Subject: Re: Building List This does what you want: L = { {1, 2}, {3, 4, 5, 6}, {7, 8} }; L /. {x_Integer, y1_Integer, y2 : _Integer ..} :> Apply[Sequence, Map[{x, #} &, {y1, y2}]] The pattern {x_Integer,y1_Integer,y2:_Integer..} matches lists of 3 or more integers, and :> Apply[Sequence, Map[{x, #} &, {y1, y2}]] implements the replacement that you defined. Steve Luttrell > Re Mathematica 5.0.1.0. > I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and > want to replace element-lists (whose length exceeds 2) with another list > built from that element. All else is untouched. > For instance, using L above, replace {3,4,5,6} with {3,4}, {3,5}, {3,6}. > This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, > {7,8} }. > Although I can do this using Sow and Reap, am hoping there's an easier > way using rules (/.). In general, I want to replace those L-elements x > (that meet a criterion) with foo[x]. > Bruce === Subject: Re: Building List How's this? modifylist[list_List] := Block[{g}, (g @@ list) /. {a_, b__ /; Length[{b}] > 1} :> Sequence @@ Thread[{a, {b}}] /. g -> List ] --Mark > Re Mathematica 5.0.1.0. > I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and > want to replace element-lists (whose length exceeds 2) with another list > built from that element. All else is untouched. > For instance, using L above, replace {3,4,5,6} with {3,4}, {3,5}, {3,6}. > This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, > {7,8} }. > Although I can do this using Sow and Reap, am hoping there's an easier > way using rules (/.). In general, I want to replace those L-elements x > (that meet a criterion) with foo[x]. > Bruce === Subject: Re: Building List > Re Mathematica 5.0.1.0. > I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and > want to replace element-lists (whose length exceeds 2) with another list > built from that element. All else is untouched. > For instance, using L above, replace {3,4,5,6} with {3,4}, {3,5}, {3,6}. > This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, > {7,8} }. > Although I can do this using Sow and Reap, am hoping there's an easier > way using rules (/.). In general, I want to replace those L-elements x > (that meet a criterion) with foo[x]. > Bruce In[1]:= myRule= {a___, b_List /; Length[b] > 2, c___} :> {a, Sequence @@ Thread[{First[b],Rest[b]}],c}; In[2]:= { {1,2},{3,4,5,6},{7,8} } /. myRule Out[2]={{1,2},{3,4},{3,5},{3,6},{7,8}} -- 0% de pub! Que du bonheur et des vrais adh.8erents ! Vous aussi inscrivez-vous sans plus tarder!! Message post.8e .88 partir de http://www.gyptis.org, BBS actif depuis 1995. === Subject: Re: kuen surface Also look at: http://mathworld.wolfram.com/Sine-GordonEquation.html > http://mathworld.wolfram.com/KuenSurface.html > >>kindly I would want to know as the same graphics(kuen surface) is >>constructed with Mathematica. >>I enclose the site from where I have taken the graphics >>http://math.cl.uh.edu/~gray/Gifccsurfs/ccsurfs.html === Subject: Re: kuen surface You're looking for the breather equation associated with solitons. I'll copy the text part of my notebook ( there are actually a whole bunch of these surfaces: Clear[x,y,w,v,wb,nb,x1,y1,z1,p,q,c,d] (* My equations for pseudosphere matrix harmonic breathers*) (*cycloidal harmonics/ standing waves on the pseudosphere as Soliton breathers*) (* simpliar in structure to to the pin torus { Re[SphericalHarmonicY[3,3,t,p]],Im[SphericalHarmonicY[3,3,t,p]], SphericalHarmonicY[3,0,t,p]}*) p=1 q=Sqrt[3] d=p/q c=Sqrt[1-d^2] (* with rotation matrix M *) M={{-Sin[t],-Cos[t],0},{Cos[t],-Sin[t],0},{0,0,1}} {x1,y1,z1}={0,0,x}-(2*d/c)* Cosh[c*x]/(c^2*Sin[d*t]^2+d^2*Cosh[c*x]^2)*( M.{Sin[d*t],d*Cos[d*t],d*Sinh[c*x]}) ga=ParametricPlot3D[{x1,y1,z1},{x,-3*Pi,3*Pi},{t,-3*Pi,3*Pi},PlotPoints->100 , PlotRange->{{-3,3},{-3,3},{-5,5}},Boxed->False,Axes->False] Changing the ratio p/q gives a bunch of different surfaces: I think this specfic equation is due to Dr Sterling, but the breathers have been around in one form or another since Beltrami. Surfaces of constant negative curvature ( K= -1). > kindly I would want to know as the same graphics(kuen surface) is > constructed with Mathematica. > I enclose the site from where I have taken the graphics > http://math.cl.uh.edu/~gray/Gifccsurfs/ccsurfs.html === Subject: Re: Mandelbrot Set & Mathematica > I'm looking for a program using Mathematica commands to obtain the > Mandelbrot set representation without using the .m file Fractal > downloadable from Mathworld. Please report the Timing parameter if you have > done some tests. > TIA If this is homework: You can do it in 1 line of Mathematica. Search Help for ContourPlot and NestWhile. === Subject: Re: Mandelbrot Set & Mathematica > I'm looking for a program using Mathematica commands to obtain the > Mandelbrot set representation without using the .m file Fractal > downloadable from Mathworld. Please report the Timing parameter if you have > done some tests. > TIA This is what I did for a Dynamical Systems course. It is based on code from the help files. It includes knowledge about points that are in the Mandelbrot set. Clear[c, test, niter, BlackWhite, mandelbrot]; BlackWhite = If[# == 1, GrayLevel[0], GrayLevel[1]]&; niter = 100; test = (Abs[#] =BE 2) &; mandelbrot[c_] := 0 /; Abs[c] > 2; mandelbrot[c_] := 1 /; Abs[c + 1] < 1/4; mandelbrot[c_] := 1 /; 16 Abs[c]^2 < 5 - 4 Cos[Arg[c]]; mandelbrot[c_] := (Length@NestWhileList[(#^2+c)&,c,test,1,niter]-1)/niter; DensityPlot[mandelbrot[x + y I], {x, -2, .5}, {y, 0, 1}, PlotPoints -> {600, 300}, Mesh -> False, ImageSize -> 600, AspectRatio -> Automatic, ColorFunction -> BlackWhite]; Color can be added defining new color functions. I like rainbow = Hue[.8(1 - #)]& Julian Aguirre UPV/EHU === Subject: RE: Building List Here are two methods. The second may be faster if ell is very long. ell={{1,2},{3,4,5,6},{7,8}}; rule1={a___List,{b_,c_,d__},e___List}:>{a,{b,c},{b,d},e}; ell//.rule1 {{1,2},{3,4},{3,5},{3,6},{7,8}} rule2={b_,c_,d__}:>Sequence[{b,c},{b,d}]; f=#//.rule2&; f/@ell {{1,2},{3,4},{3,5},{3,6},{7,8}} DrBob www.eclecticdreams.net -----Original Message----- === Subject: Building List Re Mathematica 5.0.1.0. I have a list of lists -- e.g., L = { {1,2},{3,4,5,6},{7,8} } -- and want to replace element-lists (whose length exceeds 2) with another list built from that element. All else is untouched. For instance, using L above, replace {3,4,5,6} with {3,4}, {3,5}, {3,6}. This transforms L to the desired form { {1,2}, {3,4}, {3,5}, {3,6}, {7,8} }. Although I can do this using Sow and Reap, am hoping there's an easier way using rules (/.). In general, I want to replace those L-elements x (that meet a criterion) with foo[x]. Bruce === Subject: Re: Simple question >This is simple question, but I do not know how to go about >searching for it in this user groups data base. I also could not >find a reference to the solution in the Mathematica Book. How >does one assign the result of Solve[.] or FindRoot[.] in the form >{x1-> 3.14,x2->0.763} to the two variables y1,y2 respectively?? Use ReplaceAll i.e. {y1,y2} = {x1,x2}/.{x1-> 3.14,x2->0.763} For more detail look up ReplaceAll in either the Mathematica Book or Help Browser -- To reply via email subtract one hundred and four === Subject: Re: Simple question >This is simple question, but I do not know how to go about searching for it >in this user groups data base. I also could not find a reference to the >solution in the Mathematica Book. How does one assign the result of >Solve[.] or FindRoot[.] in the form {x1-> 3.14,x2->0.763} to the two >variables y1,y2 respectively?? Let's call your solution sol: sol = {x1-> 3.14,x2->0.763}; I guess that {y1,y2} = {x1,x2} /. sol would do what you want. kind. They can sometimes be tedious because you have to reproduce the structure of the result twice. With ToValues you can still assign the values to your variables, such as in {y1,y2} = ToValues[sol] but the procedure can be used as a postfix operator without having to build a pure function (as in the case of the replacement) {y1,y2} = sol // ToValues Moreover, it can understand the structure of the solution of systems of equations in several variables and arrange the values avoid unnecessary nesting of parenthesis. (unnecessary for the naive use For example, suppose you want to solve the equation x^5==1: sols= Solve[x^5 == 1] // ToValues {1, -(-1)^(1/5), (-1)^(2/5), -(-1)^(3/5), (-1)^(4/5)} Its functionality is essentialy of cosmetic nature: the code is just a little bit cleaner. ToValues can also perform some actions, if instructed to do so. It allows you to specify a function that can do things on the values extracted. In this case we extract the real and imaginary parts and enclose them into a list structure to use to plot the points in the complex plane. cmplxToXY[z_]:={Re[z], Im[z]} pts = ToValues[ Solve[x^5 == 1, x], cmplxToXY ] // N; ListPlot[pts, AspectRatio -> Automatic]; The functions can also be indexed, but that means going too far away from what you asked. The code for ToValues is the following: (**** Code begins ****) ToValues::usage = ToValues[li] suppresses the Rule wrapper in every part of the list li.n ToValues[li,F] applies the function F to every rhs of Rule, turning var->value into F[value]. If the function F has a parametrized head, then it is possible to pass to it the lhs of Rule by setting the option IndexedFunction->True. It will turn var->value into F[var][value].n When the option Flattening is set to Automatic, ToValues flattens li in order to simplify its structure (the flattening is tuned to get the simplest list of values for the solution of a system of several equations in several variables). With Flattening set to None the original structure is left intact.; Options[ToValues] = {Flattening -> Automatic, IndexedFunction -> False}; ToValues[li_, opts___Rule] := Module[ {newli, vars, sols, fl}, fl = Flattening /. {opts} /. Options[ToValues]; sols = First[Dimensions[li]]; vars = Last[Dimensions[li]]; newli = li /. (_ -> v_) -> v; If[fl == Automatic && vars == 1, newli = Flatten[newli]]; If[fl == Automatic && sols == 1, First[newli], newli] ] ToValues[li_, fun_, opts___Rule] := Module[ {newli, vars, sols, foo, fl, mi}, mi = IndexedFunction /. {opts} /. Options[ToValues]; fl = Flattening /. {opts} /. Options[ToValues]; If[mi == True, newli = li /. (x_ -> v_) -> foo[x][v], newli = li /. (_ -> v_) -> foo[v]]; sols = First[Dimensions[li]]; vars = Last[Dimensions[li]]; If[fl == Automatic && vars == 1, newli = Flatten[newli]]; If[fl == Automatic && sols == 1, First[newli], newli] //. foo -> fun ] (**** Code ends****) cheers, Peltio === Subject: Re: Simple question > Hi All, > This is simple question, but I do not know how to go about searching for it > in this user groups data base. I also could not find a reference to the > solution in the Mathematica Book. How does one assign the result of > Solve[.] or FindRoot[.] in the form {x1-> 3.14,x2->0.763} to the two > references in the M book. George Kamin Read the * Manual i.e the mathematica book :-) In[1]:= l={x1->3.14,x2->0.763}; In[8]:= y1=Last[First[l]] Out[8]= 3.14 In[9]:= y1 Out[9]= 3.14 In[10]:= y2=Last[Last[l]] Out[10]= 0.763 In[11]:= y2 Out[11]= 0.763 There's a shorter way,guess :) === Subject: Re: Simple question Just do a bit of generalization from the examples given in the Mathematica Book, section 1.5.7 Solving equation, about getting values from the rules provided by Solve with a single variable: {y1, y2} = {x1, x2} /. {x1 -> 3.14, x2 -> 0.763} {3.14, 0.763} > Hi All, > This is simple question, but I do not know how to go about searching for it > in this user groups data base. I also could not find a reference to the > solution in the Mathematica Book. How does one assign the result of > Solve[.] or FindRoot[.] in the form {x1-> 3.14,x2->0.763} to the two > references in the M book. George Kamin -- 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 fax 413 545-1801 Amherst, MA 01003-9305 === Subject: Re: Simple question > Hi All, > This is simple question, but I do not know how to go about searching for it > in this user groups data base. I also could not find a reference to the > solution in the Mathematica Book. How does one assign the result of > Solve[.] or FindRoot[.] in the form {x1-> 3.14,x2->0.763} to the two > references in the M book. George Kamin You can do this, for example: {a, b} = {x, y} /. {x -> 2, y -> 3} After this command, a = 2 and b = 3 Denis Maciel === Subject: Re: FindRoot cannot find obvious solution The recommendation to simply set EvaluateNumericalFunctionArgument to False ( http://support.wolfram.com/mathematica/mathematics/numerics/nsumerror.html ) can be a bad idea. The reason is that with the default settings for FindRoot the jacobian is still pre-evaluated. Hence it may happen that we are evaluating one function and using the derivative of an entirely different function: In[1]:= Developer`SetSystemOptions[EvaluateNumericalFunctionArgument -> False]; Module[{f = If[TrueQ[# > 0], #, -#] &}, FindRoot[f[x] == 2, {x, 1}] ] FindRoot::lstol: The line search decreased the step size to within tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the merit function. You may need more than MachinePrecision digits of working precision to meet these tolerances. Out[2]= {x -> 1.} One way is to use RuleDelayed for Jacobian: In[3]:= Developer`SetSystemOptions[EvaluateNumericalFunctionArgument -> False]; Module[{f = If[TrueQ[# > 0], #, -#] &}, FindRoot[f[x] == 2, {x, 1}, Jacobian :> {{f'[x]}}] ] Out[4]= {x -> 2.} This method isn't guaranteed to work either, because the first step in evaluation of f'[x] is to evaluate f', and the question of how Mathematica does that is equally unclear: In[5]:= Module[{f, g}, f = If[TrueQ[# > 0], #, -#] &; g[x_] := If[TrueQ[x > 0], x, -x]; {f', g'} ] Out[5]= {If[TrueQ[#1 > 0], 1, -1] &, -1 &} The output for g' agrees with what the documentation says: g' is evaluated as Evaluate[D[g[#],#]]& (actually the reference for Derivative says D[f[#]&,{#,n}], which doesn't make any sense. So I assume it was supposed to mean Evaluate[D[f[#],{#,n}]]&). But f' is evaluated differently, because there are special rules for the derivatives of pure functions (or maybe specifically for control structures like If). Because of this, the safest way is still to use f[x_?NumericQ], even with EvaluateNumericalFunctionArgument->False, to block the evaluation of f'...and then to hope that it doesn't give some unexpected effect in combination with Compiled->True (which is the default setting for all numerical functions that use Compiled). Maxim Rytin m.r@prontomail.com