I have a slight problem with pairing up boundary points of BoundaryMesh with appropriate BoundaryNormals. Let's work with a simple domain for now: Needs["NDSolve`FEM`"] box = ToBoundaryMesh[Rectangle[], "MeshOrder" -> 1]; Now the problem is, that box["BoundaryNormals"] is nested: this will be important later. However, we can unnest it and show the normals: boxCoords = box["Coordinates"]; normals = Partition[Flatten@box["BoundaryNormals"],2]; Graphics@MapThread[Arrow[{#1, #2}] &, {boxCoords, normals/15 + boxCoords}] And this shows the problem: Normals are not appropriately oriented and some of them are messed up on the same side! My favorite domain is the following: dom = ImplicitRegion[(x - 1/2)^2 + (y - 1/2)^2 >= (1/4)^2, {{x, 0, 1}, {y, 0, 1}}]; boundary = ToBoundaryMesh[dom, "MeshOrder" -> 1]; bndry = Partition[Flatten[boundary["Coordinates"]], 2]; normals = Partition[Flatten[boundary["Bound...

Given an einsum like below, how could I generate an efficient computation graph for it? $$X_{ik} M_{ij}M_{kl} X_{jl}$$ The indices range from $1$ to $d$ and the goal is to minimize computation time assuming $d$ is large. IE, prefer $O(d^{k})$ to $O(d^{k+1})$ . For the sum above, it can be computed as follows: $$A_{kj}=X_{ik} M_{ij}\\B_{kj} = M_{kl} X_{jl}\\c=A_{kj}B_{kj}$$ You could specify this solution in terms of indices occurring in the expression A={ik,ij} B={kl,jl} c={A,B} More compactly, the problem and solution can be encoded as follows: input: {ik, ij, kl, jl} output: {{ik, ij}, {kl, jl}} This is likely to be an NP-complete problem, but there are probably heuristics to find near-optimal solution most of the time. Edit : the most important case for practical applications was when result can be expressed in terms matrices, which can be done using Carl Woll's package in the answer. Specifically, it seems to work to get efficient matrix expression for the following einsum ...

w[n_] := Expand[Sum[Binomial[n - k - 1, k]*(-1)^k*A^(n - 2*k - 1), {k, 0, n - 1}]] f[x_, y_, z_] :=PolynomialRemainder[(w[z] - 1)*(w[y] - 1), (w[x] - 1), A] For[i = 3, i Print[{i, j, k}, N[Max[FindInstance[{Abs[f[i, j, k]] - Abs[w[i] - 1]} == 0 && 3 Above code gives max A for all each cases. My aim is to find max A for all cases. Q2: How can i reduce the time for above code? Thank you. Answer Artes’ comment suggests there is a problem with the concept of optimum you are trying to find. Let me make the more general point about how your code may be improved. First, if you have a triply nested For loop, you are probably doing it wrong. Consider Table instead, or some of the other constructs mentioned here . Second, you don't need to go through every combination of {i, j, k} since you only want the cases where i . I think you can get this set of combinations using Subsets[Range[3,450],{3}] which gives the ordered subsets of exactly length 3. Third, functional progra...

I'm trying to use Manipulate to visually try out different values of lambda in a Box-Cox transformation . I've created a boxcox function with two definitions to deal with both the normal case and the case when lambda is 0: boxcox[data_, 0] := Log[data] boxcox[data_, l_] := (data^l - 1)/l Then I use this function inside Manipulate but I keep getting tons of errors. It looks like Manipulate is only using the general definition and starts complaining about dividing by zero. Manipulate[ pdata = Partition[boxcox[data, u], 12]; ranges = Max[#] - Min[#] & /@ pdata; means = Mean[#] & /@ pdata; mrdata = Transpose[{means, ranges}]; mrlm = LinearModelFit[mrdata, x, x]; Show[ ListPlot[mrdata, Axes -> False, Frame -> True, AxesOrigin -> {Automatic, 0}], Plot[mrlm[x], {x, Min[means], Max[means]}] ], {u, 0.00, 1.00} ] Here is the data I'm using in case it matters: data = {154., 96., 73., 49., 36., 59., 95., 169., 210., 278., 298., 245., \ 200., 118., 9...

I have an issue testing functions that generate formatted output. For example: 1) Create a new testing notebook and a new test like this: 2) Now execute the test (it fails as expected) 3) Now click the "Replace Output" button and run it again: Why is it failing? Lets show the cell expressions to see if there is a hidden difference: I don't see any significant difference. So my question is: is this a bug or should I do something different when testing functions that generate grids? In the meanwhile, I have found that this works: Testing functions that generate grids fails in this simple example:

Given the matrices $\gamma_{k}=\begin{bmatrix} O & -i\sigma_{k}\\ +i\sigma_{k}& O \end{bmatrix}$ where $\sigma_{k}$ is the $k^{th}$ Pauli matrix $\gamma_{4}=\begin{bmatrix} I^{2} &0 \\ 0 & -I^{2} \end{bmatrix}$ $\gamma_{5}=\gamma_{1}.\gamma_{2}.\gamma_{3}.\gamma_{4}$ The anticommutator rule is defined by $\left [ x,y \right ]=xy+yx$ Show that the anticommutator relation $\gamma_{u}.\gamma_{v}+\gamma_{v}.\gamma_{u}=2\delta _{u v}I$ is satisfied for all $u,v=1,2,3,4$ where $I$ is the $4 \times 4$ identity matrix. What I have defined is \[ScriptCapitalO] = {{0, 0}, {0, 0}}; Subscript[\[Gamma], 1] = {{\[ScriptCapitalO], -I PauliMatrix[1]}, {I PauliMatrix[1], \[ScriptCapitalO]}}; Subscript[\[Gamma], 2] = {{\[ScriptCapitalO], -I PauliMatrix[2]}, {I PauliMatrix[2], \[ScriptCapitalO]}}; Subscript[\[Gamma], 3] = {{\[ScriptCapitalO], -I PauliMatrix[3]}, {I PauliMatrix[3], \[ScriptCapitalO]}}; Subscript[\[G...

Mathematica has numerous functions designed to, or capable of, fitting known functions, and finding unknown functions to match data sets. What are some common issues that come with finding those fits?

It's now possible to import photographs into Mathematica and import the EXIF data at the same time: i = Import["ExampleData/coneflower.jpg", "ImageWithExif"] You can now look at all the metadata: Options[i, MetaInformation] {MetaInformation -> {"Exif" -> {"ImageDescription" -> " ", "Make" -> "NIKON", "Model" -> "E950", "Orientation" -> 1, "XResolution" -> 300, "YResolution" -> 300, "ResolutionUnit" -> 2, "Software" -> "Adobe Photoshop CS3 Macintosh", "DateTime" -> "2008:08:19 11:29:05", etc... So how would I extract - say - the exposure time ("ExposureTime")? I was trying something like this: "ExposureTime" /. Options[i, MetaInformation] ... but I don't know enough about the structure of the stored metainformation. Can you do this without knowing that struct...

I wanted to remove the Ticks in my coding but i can't. Here when i try to remove the Ticks the number also gone. I need numbers without Ticks , Ticks and GridLines should be automatic and don't use PlotRange . BarChart[{{1, 2, 3}, {4, 5, 6}}, ImageSize -> 400, BarOrigin -> Left, ChartLayout -> "Stacked", ImageSize -> {500, 300}, GridLines -> {Automatic, None}, Ticks -> {{Automatic}, None} , LabelStyle -> Directive[Opacity[1]], TicksStyle -> Directive[Opacity[.3]] , Axes -> {True, False}, AxesStyle -> Opacity[.0], ChartStyle -> {RGBColor[.06, .29, .66], RGBColor[.01, .56, .61], RGBColor[1, .58, 0]}, ChartBaseStyle -> EdgeForm[GrayLevel[.6]]]

Is it possible to define an assumption like this: $Assumptions=f[__]>0 So that: Simplify[f[x]+3==0] (*False*) Simplify[f[a,b,c]+4==0] (*False*) Etc... The way above doesn't work, but is intended to show what I want to do. I have this function f, that appears in many coordinate systems, and this way would be nice to avoid adding many assumptions for each set of arguments. Answer There is another alternative which you could look into: dynamically creating your assumptions. I will try to show it with the simple example you have given. Basically, when you call Simplify[f[a,b,c]+4==0] then you can easily extract the expressions matching your pattern with Cases . For instance Cases[Hold[Simplify[f[a, b, c] - f[x] == 0]], f[__], Infinity] (* {f[a, b, c], f[x]} *) The same is true for your assumptions. You can easily extract the pattern you use. The next may look a bit weird, because we have to create a pattern, that matches a pattern... Cases[f[__] + 3 > 0 && x + 3 == 2, ...

I have come across the (internal) use of the function: Internal`LocalizedBlock I am trying to determine its purpose. It seem to behave like Internal`InheritedBlock except that a starting value (e.g. {x = 3} ) cannot be set. x = "global"; f[] := x Internal`LocalizedBlock[{x}, {x, x = 7, f[], Hold[x]}] x Internal`InheritedBlock[{x}, {x, x = 7, f[], Hold[x]}] x {"global", 7, 7, Hold[x]} "global" {"global", 7, 7, Hold[x]} "global" What purpose does this function serve? Why would it be used in place of InheritedBlock ? Answer Internal`LocalizedBlock behaves the same as Block , but it can localize non-Symbols (e.g. f[1] , Subscript[x, 0] , etc.). For example, Internal`LocalizedBlock[{Subscript[x, 0]}, Subscript[x, 0] = 1] (* 1 *) Compare this to Block[{Subscript[x, 0]}, Subscript[x, 0] = 1] (* During evaluation of In[79]:= Block::lvsym: Local variable specification {Subscript[x, 0]} contains Subscript[x, 0], which is not a symbol or an as...

I have tried the following: usentity = Entity["Country", "UnitedStates"]; uspoly = usentity["Polygon"]; stdpoly = uspoly /. GeoPosition -> Identity; RegionQ[stdpoly] [1] True RegionMember[stdpoly, {35, -90}] returns unevaluated. Is there a better approach? Answer If you look at the structure of the Polygon , it seems there is an extra level of {} that needs to be removed Short@stdpoly (* Polygon[{{{49.0021,-122.758}, >}}] *) So you can use FlattenAt to remove that layer of brackets, stdpoly2=FlattenAt[stdpoly,{1,1}]; Short@stdpoly (* Polygon[{{{49.0021,-122.758}, >}}] *) The polygons appear the same RegionPlot /@ {stdpoly, stdpoly2} and now you can use RegionMember all you like RegionMember[stdpoly2, {35, -90}] (* True *) There is also the fact that for some reason, geographic polygons have their coordinates reversed, as I learned here . This is what I did there, stdpoly = Polygon @@ First@First@uspoly // Map[Reverse, #, {-2}] &; Graphics...

This question may be trivial, but I can't get past it for the life of me. I have $n$ matrices of dimension $p_i \times N_i$, with $i$ indexing the $n$-set. I also have $n$ vectors of the appropriate length. I'm looking to create a list of the inner products. This works (obviously): MapThread[Dot[#1,#2]&,{nmats,nvecs}] The problem comes in when I pass in lists of nmats . That is, I have $C$ copies of nmats stored in cnmats and want to collect the above for each. For some reason Map ping works, MapThread[Dot[#1,#2]&,{#,nvecs}]&/@cnmats but Thread ing doesnt Thread[MapThread[Dot[#1,#2]&,{#,nvecs}]&[cnmats]] Replacing MapThread with Table moves the error to Dot: Nonrectangular tensor encountered. The error returned is: Incompatible dimensions of objects at positions {2, 1} and {2, 2} of (MapThread expression); dimensions are n and C $C$ and $N_i$ are $O(10^5)$, $p$ is $O(1)$, so I favor Thread for the speed advantage. Why can't I thread here? How can I ...

I'd like to fill a curve in a ParametricPlot3D in the same way as I might with ListPointPlot3D ; i.e., ListPointPlot3D[data, ColorFunction -> "Rainbow", Filling -> Bottom] I obtained the data numerically, point-by-point, with MATLAB. I have found a parametric expression for $y$ ($y = f(x)$) and I have a function $F(x, y, z)$, but I want to plot $F$ only for the curve $y = f(x)$, i.e., the 3D surface is defined as Plot3D[x^2 Sin[x] + y^2 Cos[y] - x y, {x, 0, 1}, {y, 0, 1}] and I want to plot only the specific line of surface which satisfy $y = f(x) = x^2$ using ParametricPlot3D[{x, x^2, x^2 Sin[x] + y^2 Cos[y] - x y /. y -> x^2}, {x, 0, 1}] I'd like to add a filling, but I don't know how. When I type Filling -> , the Mathematica code editor complains (the text becomes red).

I have a bunch of data to which I've assigned units using Quantity , including some angular measurements in degrees. I'd like to be able to use these measurements with trigonometric functions, but it seems that trig functions don't "know" about Quantity , so I'm forced to convert those measurements to radians and then apply the trig function to the magnitudes, like this: x = Quantity[23.4, "AngularDegrees"] Cos[QuantityMagnitude @ UnitConvert[x, "Radians"]] This works, but it's slow and seems clunky, at best. Is there a more elegant (and hopefully faster) approach?

Here's the situation in my Mathematica Notebook: I'd like the bottom cell to be grouped with the cells above it. Here are those same cells toggled into code: Cell["How to get new text cells to group right?", "ItemNumbered", WholeCellGroupOpener->True, CellGroupingRules->{GroupTogetherGrouping, 10000.}] Cell["This is text...", "Text", CellGroupingRules->{GroupTogetherGrouping, 10000.}] Cell["This is code...", "Program", CellGroupingRules->{GroupTogetherGrouping, 10000.}] Cell[BoxData[ RowBox[{"why", " ", "am", " ", "I", " ", "not", " ", "in", " ", "the", " ", RowBox[{"group", " ", ":", "("}]}]], "Input", CellGroupingRules->{GroupTogetherGrouping, 1001.}] I have cell grouping set to Manual Grouping in the Cell ► Grouping menu. ...

I can get the Ridge or Tikhonov regression solution to Y = \[Beta].X easily enough as \[Beta] = Inverse[Transpose[X].X + \[Lambda] IdentityMatrix[ Dimensions[X][[2]]]].Transpose[X].Y for a given regularization parameter \[Lambda] . But I want to use LinearFitModel (or otherwise) to create a FittedModel object so I have access to all it's availible statistics and properties. I haven't been able to find any documentation on how to do this or if it's even possible. Is there a way to do this? Thanks!

Here's an integral that comes up in calculating the number of domino tilings of the plane: Integrate[Log[(Sin[k] + Sqrt[1 + Sin[k]^2])^2], {k, 0, π}] (* 4 Catalan *) And here is the same result with a trivial addition: Integrate[Log[(Sin[k] + Sqrt[1 + Sin[k]^2])^2] + x, {k, 0, π}] (* 4 Catalan + π x *) But if I change the integrand into a series, the result is different: Integrate[Log[(Sin[k] + Sqrt[1 + Sin[k]^2])^2] + x + O[x]^2, {k, 0, π}] (* 4 Catalan + π (x + Log[2]) *) Note the additional term independent of x . Surely this is a bug? I'm using Mathematica 11.0.1 on Windows 10 (64-bit).

I want to plot this: $\displaystyle\sum_{n=-{10}\atop n\ne \pm 1}^{10} \dfrac {4i(-1)^{n}n}{(n^2 - 1)^2}e^{inx}$ but have no idea how I can exclude the cases for when $ n = \pm 1 $. I don't wish to split up the summation into two parts either. Thanks.

I do quite a bit of textual analysis with Mathematica , and am currently making some Manipulate objects to walk people through key terms in the database. One issue I am running into with Manipulate however is that it continues to evaluate. For example, please consider the following code: ( warning, this code does loop FWIW ) testInput = {{"the", 4415}, {"of", 1284}, {"and", 1608}, {"in", 1384}, {"to", 1353}, {"a", 1205}, {"coal", 815}, {"was", 753}, {"by", 459}, {"were", 449}, {"for", 382}, {"is", 362}, {"with", 324}, {"from", 322}, {"on", 317}, {"that", 311}, {"as", 302}, {"mines", 264}, {"s", 257}, {"mining", 257}, {"it", 253}, {"this", 244}, {"at", 244}, {"be", 225}, {"cape", 216}}; testInput2 = {{"the...

I am trying to learn "core" patterns so I can start using them more often. Consider I am trying to solve the following problem. data = {2,{4,2,3},5,{7,3},{},4,1} (assume List will not appear beyond level 1) To get only non-list elements I can use the following pattern. data //. {x:___,{___},y:___}:>{x,y} Is there a way to do the same using a sub-pattern replacement (regular expressions allow that) data//.{___,t:{___},___}:>Nothing (I want to only replace t with Nothing ) Next how do I get only list elements. data //. (...) Allowed functionality: • Basic Pattern Objects • Composite Patterns • Restrictions on Patterns • Pattern Defaults > • Replace (third argument levelspec NOT allowed) • ReplaceAll • ReplaceRepeated

Actually, the title says it all. I am a little confused why such a complicated object as Graph , with many different parts, was designed to be atomic in Mathematica language such that, for example, function Part cannot be used on it.

I would like to use Compile with functions defined outside Compile . For example if I have the two basic functions F and G F[x_] := x + 2 G[x_] := x And I want to compute F[G[x]] in Compile compiledFunction = Compile[{{x, _Real, 0}}, F[G[x]] ] The resulting compiled function calls MainEvaluate FastCompiledFunctionQ[function_CompiledFunction]:= ( Needs["CompiledFunctionTools`"]; StringFreeQ[CompiledFunctionTools`CompilePrint@function,"MainEvaluate"] ) compiledFunction // FastCompiledFunctionQ This returns False , where FastCompiledFunctionQ[] checks if a compiled function calls MainEvaluate in order to use normal Mathematica code instead of compiled code, which is usually slower than compiled code. Is there a way around this? More generally I want to compile almost any numerical Mathematica code that calls user-defined functions (which themselves can call other user-defined functions) and doesn't use symbolic computations. Answer Yes there is a way...

I have been using the Notebook in Mathematica for quite a while. While I like its interface, the problem is successive statements sometimes get read into different Inputs, and when I am rerunning the file, I need to run all the Inputs sequentially. Correspondingly separate outputs are produced. For a long file, running Inputs one by one is time consuming. I would like to have a Matlab-script environment, where I enter the code completely, and print the outputs to be displayed at the end. Executing the script once will get me all the outputs consecutively in one place. Is such an inputting possible for Mathematica . Apologies if the question is too naive and easy.

I'm trying to write an expression deconstructor or FullForm -capturer; might even call it a parser, maybe, but that might be too glorious a word. I got some great ideas from "Head and everything but..." , but have plunged headlong back into the fog of my own limited understanding again, which got even foggier when I tried to understand "...function arguments on a stack..." . I'd be most grateful for ideas, advice, and more clarity. Consider this example: a + b + c . We know its FullForm is Plus[a, b, c] , and I can "capture" that FullForm in a List with something like Cases[{a + b + c}, head_[args___] -> {head, args}] which produces {{Plus, a, b, c}} Now I go get myself all drunk on recursion and think I can write SetAttributes[capture, HoldAllComplete]; capture[expr_?AtomQ] := {Head@expr, expr}; capture[head_[args___]] := {head, capture /@ {args}}; so that something like capture[a + b + c] gives me fantastic detail {Plus, {{Symbol, a}, {Sym...

I do believe this sort of similar questions had been asked many times, so I have read a LOT. For example this and this as well as many other related posts. But a glance at what my main question is this: Needs["Notation`"] Symbolize[ParsedBoxWrapper[SubscriptBox["x", "_"]]] Symbolize[ParsedBoxWrapper[SubscriptBox["y", "_"]]] var1 = Table[ToExpression["Subscript[x, " ToString[i] "]"], {i, 10}] var2 = Table[ToExpression["Subscript[y, " ToString[i] "]"], {i, 10}] 1/(1 + Exp[var1 + var2]) (* Does not work *) Variables[%] 1/(1 + Exp[var1 + var2]) (* Does work *) Variables[Level[%,4]] Now the real challenge is: I need expression for TWO sets of variables (symbols) $p_{jc}$ and $\phi_{jc}$, like this $$ p_{jc} = \frac{1}{1+\exp{(-\mu_p-\tau_{pj}-\eta_{pc}})} $$ and $$ \phi_{jc} = \frac{1}{1+\exp{(-\mu_\phi-\tau_{\phi j}-\eta_{\phi c}})} $$ for different $j$s and $c$s. Ideally, I want to define varia...

I have two lists: u = {{1, 3}, {2, 6}, {3, 9}} v = {0, 4} and I want to obtain this list from them: z = {{{0, 1}, {4, 3}}, {{0, 2}, {4, 6}}, {{0, 3},{4, 9}}} I guess the solution will make use of Map, Thread, or even MapThread but I've tried every combinaison I can think of with no luck. How can I do it? Answer This works: Transpose[{v, #}] & /@ u {{{0, 1}, {4, 3}}, {{0, 2}, {4, 6}}, {{0, 3}, {4, 9}}}

I am trying to reduce a bunch of inequalities using the Reduce command in Mathematica. But the output is very convoluted and I am wondering if there's a way to systematically organize it so that I can actually write it on a piece of paper, or at the very least, read it correctly. For example, Reduce[h1>=0 && h2>=0 && 2*x>=0 && -m+h1+y>=0 && m+x-y>=0 && h2-x+2y>=0, {x,y}] produces output that looks like this which, needless to say, looks horrendous. Is there a way to clean this up? Answer If you are OK with turning the Or s into Column s, you can do something like: result = Reduce[ h1 >= 0 && h2 >= 0 && 2*x >= 0 && -m + h1 + y >= 0 && m + x - y >= 0 && h2 - x + 2 y >= 0, {x, y}]; TraditionalForm[ result //. {Or -> (Column[#, Right, Background -> {{White, LightGray}}, Frame -> All] &)@*List}]

I have a list: testList={{"a","b 3","cd","ef 23"},{"z 12","y","x"}} and wish to obtain resultList={{"b 3","ef 23"},{"z 12"}} ...where I have deleted list items which do not include (string representations of) numbers. My thoughts on how to do this lead to the opposite of elegant code. Any ideas gratefully received. Thank you for your responses! I have a related question. Using the following list: testList2={{"a","b 3","cd","ef 23"},{"z 12","y","x"},{"z","y"}} I wish to keep list members that contain string representation of numbers and delete list members that don't, which will give: resultList2={{"a","b 3","cd","ef 23"},{"z 12","y","x"}} in this case, the third list item in testList2 gets dropped because its elements don'...

I have imported the following data from Excel: s = {{{0.166667, 0.333333, 0., 0., 0., 0.166667}, {0.0833333, 0., 0.166667, 0.0833333, 0., 0.166667}, {0.333333, 0.0833333, 0.166667, 0.166667, 0.0833333, 0.166667}, {0.416667, 0.5, 0.583333, 0.666667, 0.833333, 0.333333}, {0., 0.0833333, 0., 0., 0.0833333, 0.}, {0., 0., 0., 0.0833333, 0., 0.166667}, {0., 0., 0.0833333, 0., 0., 0.}}} My purpose is now to create a stacked area chart in Mathematica, of the kind shown in the diagram below. My question is, how can I do that using my data? Answer You can use StackedListPlot : StackedListPlot[s[[1]]] StackedListPlot[s[[1]], FillingStyle -> {4 -> White}] Alternatively, you can use ListLinePlot with the option PlotLayout ->"Stacked" : ListLinePlot[s[[1]], PlotLayout -> "Stacked", Filling -> Automatic, FillingStyle -> {4 -> White}, PlotRange -> All]

I am unable to do this definite integral in Mathematica 9 . Is there any command so that I can get the numerical value of the above integration? Code: A1 = (A*2^2*Sin[theta]*Cos[theta])/((1 - (2^2*Cos[theta]^2)^2)) A3 = NIntegrate[A1, {theta, 0, (Pi/2)}]

I have a ContourPlot where I have let Mathematica draw the contours automatically. I would like to extract the zmax and zmin contour values that have been determined internally so that I can pass them to ShowLegend to be shown with the color-bar. I am using Mathematica 8. Needs["PlotLegends`"] plTest = ContourPlot[xv^2 + yv^2, {xv, 0, 1}, {yv, 0, 1}, Contours -> 9, ColorFunction -> "Rainbow"]; ShowLegend[plTest, {ColorData["Rainbow"][1 - #1] &, 10, "max", "min", LegendPosition -> {0.6, 0}, BaseStyle -> {FontSize -> 14}}] I would like the actual zmax and zmin values to appear in the colorbar in the legend instead of the "max" and "min" above. Can someone please help me with this? There is a similar post: ShowLegend values , but I can't get this to work with ContourPlot type. Thanks. Answer The question refers to my answer to "ShowLegend values" and mentions that it doesn't ...

At the moment, I am producing various complicated interactive plots. They all share a common "code base", with modifications on top of it. I would like to refactor my code so that the various files call the common "code base". However, the code must be portable - only relative to the current directory. What is the simplest way to achieve this? Packages seem complicated, and .nb files are preferable to .m files in my current setup. Therefore I have looked into a setup with library.nb followed by Import["library.nb"] in the other files. I couldn't get this to work for some reason, and would appreciate some guidance.

I am new to Mathematica and have recently been exploring graphical animations. So I was experimenting with simple concepts in periodic motion and hence wondered how can I draw a simple spring? Is there an easier/better way to do this? The solution I arrived at was a simple function to draw a spring between two $x$ and $y$ coordinates. hspring[a0_, x10_, x20_] := Module[{a = a0, x1 = x10, x2 = x20, n = 100}, h = (x2 - x1)/n; xvalues = Table[k, {k, x1, x2, h}]; yvalues = Table[a Sin[m Pi/2], {m, 0, n}]; Line[Transpose @ {xvalues, yvalues}] ]; vspring[a0_, y10_, y20_] := Module[{a = a0, y1 = y10, y2 = y20, n = 100}, h = (y2 - y1)/n; yvalues = Table[k, {k, y1, y2, h}]; xvalues = Table[a Sin[m Pi/2], {m, 0, n}]; Line[Transpose @ {xvalues, yvalues}] ]; Manipulate[ Graphics[{hspring[0.2, 0, Abs[2 Sin[x]]], Red, PointSize[0.03], Point[{Abs[2 Sin[x]], 0}]}, PlotRange -> {{0, 3}, {-1, 1}}], {x, 0.01, 2 Pi, 0.1}]

Piggybacking on this , I am somehow not fully convinced that I can't save data generated by a calculation in a mathematica file so that when I re-launch said file, I wouldn't have to run my calculations again. I ask because I use NDSolve for 4th order non linear PDEs and sometimes I need to run it for really large times (in excess of a few hours, yes that sounds crazy but I am just trying to get results for a fluid dynamics problem here and I am not all that interested in being a computer scientist to reduce run times). So after reading the linked article, I did this for an example problem: sol = NDSolve[{D[u[t, x], t] == D[u[t, x], x, x], u[0, x] == 0, u[t, 0] == Sin[t], u[t, 5] == 0}, u, {t, 0, 10}, {x, 0, 5}] DumpSave["pde0.mx", sol] Then I quit mathematica and relaunch it and load pde0.mx with Get Get["pde0.mx"] And when I plot, Plot3D[Evaluate[u[t, x] /. sol], {t, 0, 10}, {x, 0, 5}, PlotRange -> All] Voila, I get the plot as if I had run the si...

The command Variables[poly] gives me a list of all variables that appear in the expression poly , which involved sums, products, and rational powers. Sadly, it doesn't work for more complicated expressions, such as trigonometric functions. I was wondering if there is another command that can handle expressions such as $\sin(x)+\cos(y)$. Answer ClearAll[x, y, z, d, h, p, m, f, g, a, w]; expr = Sin[x] + Cos[y] + z^3 + Exp[d] + h + 3 h^2 + 4 h^3 + Integrate[Exp[p], p] + D[Sin[m]^Exp[f], m]*Series[Sin[g], {g, 0, 3}] + 2 (E^a BesselK[0, 2 Sqrt[E^a]]) C[2]/D[Gamma[w], {w, 2}]; Cases[Variables[Level[expr, -1]], x_ /; AtomQ[x] :> x] (* {a, d, f, g, h, m, p, w, x, y, z} *)

For a user-specified magnitude, is there a way to have Mathematica produce any 3D vector with that magnitude? Answer This should work: random3DVector[magnitude_] := magnitude * Normalize[{RandomReal[], RandomReal[], RandomReal[]}] A 3-dimensional vector in Mathematica is just a 3-element list of the components, so we make a random 3-element list, normalize it to a unit vector, and then multiply it by the desired magnitude. Edit: This approach is incorrect; it will only give vectors in the positive octant.

How can I fill the blue space between two curves, for example $\sin$ and $\cos$, with random points? What if they are two BezierCurve s instead of functions?

I am given geographic data in the form of Gauss-Krüger-Coordinates and would like to calculate distances with them and convert them to longitude/latitude coordinates in another system for plotting (e.g. WGS84 ). Gauss-Krüger-Coordinates are essentially like UTM-coordinates based upon a transversal Mercator projection where positions are indicated by a Right-value (East-value in UTM; y-coordinate in the geodetic coordinate system) and a High-value (North-value in UTM; x-coordinate int the geodetic coordinate system) Far from being an expert in geodesy the way I understand it Mathematica's geodetic functions allow entering coordinates as GeoPosition , as GeoPositionENU or as GeoGridPosition . GeoGridPosition essentially will reference to a position on a projection so probably should be the way the Gauss-Krüger-Coordinates are entered, but I am not so sure. Mathematica does not seem to know Gauss-Krüger-Projection (not listed among GeoProjectionData[] ) and I do not know which par...

Hello, GetIntersectionPoint[p1_, p2_] := Module[{pts, vecs, n, vars, distance, sol, x, y, z, t}, ( pts = p2; vecs = p1 - pts; n = Length[pts]; vars = Array[t, n]; {distance, sol} = Minimize[ Total[({x, y, z} - Transpose[pts + vecs vars])^2, 2], {x, y, z}~ Join~vars] )] I call this function with p1 and p2 where p1={{100, 100, 100},{100, 0, 100},{0, 100, 100}}; p2={{500/3, 500/3, 0},{500/3, 0, 0},{0, 500/3, 0}}; I obtain like this: {0, {x$17013 -> 0, y$17013 -> 0, z$17013 -> 250, t$17013[1] -> 5/2, t$17013[2] -> 5/2, t$17013[3] -> 5/2}} How Can I fix the rename of the local variables ?

I have data that is given as a list of ordered pairs mixed with scalars. The pairs can contain infinite bounds. My goal is to convert the data into an index used in future computations. data = {{1, ∞}, {-∞, 2}, 3, {2, 2}, {2, 3}}; This gives me all of the unique values present in data . udata = Sort[DeleteDuplicates[Flatten@data], Less] ==> {-∞, 1, 2, 3, ∞} Now I use Dispatch to create replacement rules based on the unique values. dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]]; Finally I replace the values with their indices and expand scalars a such that they are also pairs {a,a} . This results in a matrix of indices which is what I'm after. Replace[data /. dsptch, a_Integer :> {a, a}, 1] ==> {{2, 5}, {1, 3}, {4, 4}, {3, 3}, {3, 4}} NOTES: The number of unique values is generally small compared to the length of data but this doesn't have to be the case. Any real numbers are possible. The data I've shown simply gives a sense of the structural possi...

I might be missing something obvious here. I am building a palette for constructing code to make certain graphics. The idea is that my colleagues can click buttons instead of having to know the right commands. So PasteButton[] is an obvious help. Where I have gotten stuck is in color definition. What I want is for the user to be able to select a color on a ColorSlider , and then click a button to paste the RGBColor[] value selected in that ColorSlider at the notebook insertion point. I do not want the code pasted in this way to update subsequently when the user chooses a different color in the ColorSlider This is what I have so far, but the resulting pasted code does not pick up when the user has selected a different color in the slider. Pasting Dynamic[col] instead of Setting[col] results in a piece of code that changes when a different color is selected in the slider, which as I mentioned is not the desired behaviour. Grid[{{PasteButton[ Graphics[{Dynamic[col], Rectangle[]}...

When I use some function, at the end along with the output I get some NULLs returned that I don't understand the reason for and are highly undesirable. For example, when I define the reversal of list with ReverseList[ele_List] := Module[{list = List[], i, k = 1}, {For[i = Length[ele], i > 0, {i--, k++}, {AppendTo[list, ele[[i]]]}], Print[list], Return[list]} ] The output I get ReverseList[{1, 2, 3, 4, 5}] is {5,4,3,2,1} {Null, Null, Return[{5, 4, 3, 2, 1}]} I am also have a problem with returning the list. Can someone please help me with these two problems? Answer I think I understand what your trouble might be. Here is your code: a := b means that the left-hand-side is a pattern and the right-hand-side should be evaluated when that pattern is found (roughly speaking). The right-hand-side in this case is: Your function in essence returns the entire module . You can see this by changing Module to something else, like PretendModule : The point is that Mathematica is...

I have using Mathematica functions that takes a Cartesian coordinate relative to the Earth (xyz) and converts it to a latitude, longitude, and altitude (lla). And here it is: xyz2lla = First@GeoPosition@GeoPositionXYZ[#, "WGS84"] & I'm using it to convert a satellite viewing line (line of sight or los) from xyz to lla. For instance, if I have a satellite at the following observation point (obs, meters) looking in the direction of look: obs = {2.560453600382259, 5.245110323032143, -3.819772142191310} 1*^6; look = {-0.233218833096895, -0.814561997858160, -0.531128729720249}; It has the line of sight: obs+d look The transformation xyz2lla is smooth, so I was hoping to use function interpolation: f = FunctionInterpolation[{xyz2lla[obs + # look]} &[d], {d, 2000000, 3700000} ] And while this works, and I get the following lat, lon, alt functions from it: : I also get the following errors that I'm wondering why I get: GeoPositionXYZ::inv...