Tag Info

New answers tagged

2

It seems that there is a significant overhead every time a color scheme is switched. Once a scheme is loaded each use is fast, but changing color schemes apparently unloads and reloads the mechanism. The result is that the speed of application is directly related to the frequency of switching. With sorted values there is only one switch and application is ...


2

Adapting listMaxArg from linked topic seems to be the fastest. list = RandomReal[1, {10^6, 2}]; list[[Ordering[list[[All, 2]], 1]]] // AbsoluteTiming {0.010000, {{0.817248, 6.71112*10^-7}}}


1

Use the three-argument form of Thread: Thread[f[{a, b, c}, {0}], List, 1] (* {f[a, {0}], f[b, {0}], f[c, {0}]} *) See also Thread >> Details Examples: Thread[h[{0}, {a, b, c}], List, {2}] (* {h[{0}, a], h[{0}, b], h[{0}, c]} *) Thread[h[{0}, {a, b}, {u, r}], List, {2, 3}] (* {h[{0}, a, u], h[{0}, b, r]} *) Thread[h[{a, b}, {0}, {u, r}], List, {1, ...


2

The reason why the second method is failing is because you are looking for a pair whose second element is the minimum over the whole list (including all the first elements). This of course will fail whenever the global minimum is in the first position. The proper syntax is Cases[list, {_, Min[list[[All, 2]]]}] The speed improvement, on the other hand, is ...


2

The fastest I can come up with is (by separating finding the minimum second value in each pair): AbsoluteTiming@With[{min = Min@list[[All, 2]]}, Cases[list, {_, min}]] (* {1.288129, {{0.555911, 1.05947*10^-6}}} *) while MinimalBy takes much longer: AbsoluteTiming@MinimalBy[list, #[[2]]&] (* {2.074207, {{0.555911, 1.05947*10^-6}}} *) Your second ...


1

Use {a,b}->{1,1/2} for FourierParameters FourierSinSeries[x, x, 10, FourierParameters -> {1, 1/2}] This is because the Fourier sine series is defined as $b_k= \frac{2}{L} \int_0^L f(x) \sin\left( \frac{k \pi x}{L} \right) dx$ and Mathematica uses so for $L=2\pi$, if we use $b=\frac{1}{2}$ and $a=1$ then Mathematica definition becomes ...


1

I will report this to WRI, meanwhile: Quick fix is to use Pane[#, ImageMargins -> {{0, 10}, {5, 5}}] & on tabs contents. Not convenient but working. Probably also OS dependent solution... To not copy this I'm using a function which can be used directly on TabView: tabViewFix1 = Function[tabView, MapAt[ Pane[#, ImageMargins ...


3

When you define a function f, you are (a) applying Set or SetDelayed to a pattern, (b) creating a rule, (c) associating the rule with a symbol (f), and (d) storing that in DownValues (usually). FullForm[Hold[f[x_] := x^2]] (* Hold[SetDelayed[f[Pattern[x, Blank[]]], Power[x, 2]]] *) f[x_] := x^2 DownValues@f (* {HoldPattern[f[x_]] :> x^2} *) First ...


5

First a simpler way to get your first example: (m = ArrayFlatten[Transpose /@ {{v1, v2, v3}, {v4, v5, v6}}, 1]) // MatrixForm An alternative way to do @bill's undoing trick: (m2 = ArrayFlatten[Transpose /@ {{v1, ## & @@ Transpose[vNew]}, {v4, v5, v6}}, 1]) // MatrixForm Using ArrayReshape as an alternative to ArrayFlatten: ...


3

How about just breaking up the matrix and then reconstructing the same way. Here are your source vectors v1 = {1, 2, 3}; vNew = {{4, 5}, {6, 7}, {8, 9}}; v4 = {10, 11, 12}; v5 = {13, 14, 15}; v6 = {16, 17, 18}; So now define and reconstruct: {v2, v3} = Transpose[vNew]; ArrayFlatten[{Transpose@{v1, v2, v3}, Transpose@{v4, v5, v6}}, 1] // MatrixForm If ...


5

TL;DR; myArrayFlatten = Flatten /@ Flatten[#, {{1, 3}}] & {x,y,z} or {{x},{y},{z}} is considered column vector. Usage example: v1 = {1, 2, 3}; vNew = {{4, 5}, {6, 7}, {8, 9}}; v4 = {10, 11, 12}; v5 = {13, 14, 15}; v6 = List /@ {16, 17, 18}; { {v1, vNew, v1}, {v4, v5, v6, v1}, {vNew, vNew} } // myArrayFlatten // MatrixForm Flatten ...


4

ClearAll[f, g] f = ConditionalExpression[(1/27)*(#^4 - 6 #^3 + 12 #^2 + 19 #), 0 <= # <= 5] &; g = InverseFunction[f]; Grid[Partition[#, 2] &[Plot[#, {x, 0, #2}, PlotLabel -> #3, ImageSize -> 300] & @@@ {{f[x], 5, "f[x]"}, {g[x], 10, "g[x]"}, {{f[x], g[x]}, 5, "{f[x], g[x]}"}, {f[x] - g[x], 5, "f[x]- g[x]"}}]] Update: ...


1

Illustrating the problem with a simple example: f = #^2 &; g = InverseFunction[f]; InverseFunction::ifun: Inverse functions are being used. Values may be lost for multivalued inverses. g[f[3]] -3 As the message says, there may be multiple solutions. Only one is returned.


1

You need a minor modification of the answer in the linked Q/A: ClearAll[eF2] eF2[z_: y] := Module[{j = 1, p = Partition[#, 2]}, First[(z[Length@p] - p[[-1, 1]]) Exp[Total[(Subtract[##] 2 z[j++] + {# - #2}^2) & @@@ p]]]] & Examples: ClearAll[a, b, c, d, e, f] eF2[][{a, b, c, d}] (* E^((a-b)^2+(c-d)^2+2 (a-b) y[1]+2 (c-d) y[2]) (-c+y[2]) *) ...


1

You can't do this. If correct behaviour is f[{{1,2},{3,4}}] -> {f[{1,2}],f[{3,4}]} then what is correct behaviour for f[{1,2}] ??? Clearly the second expression has no idea that it came from a previous application of f unless you find some way to tell it. Map is the simple and correct way of achieving what you want; I don't believe that it is ...


0

This works: f[u_, x_] := D[u, x] + a[x] u By way of explanation, everything is an expression, and there is nothing particularly special about functions. You and I know that this definition doesn't have lot of meaning for objects "u" that aren't functions, but Mathematica doesn't need to know that u is a function.


0

I am still not sure of what you want but attempting to be helpful: f[u[x] p_, x] := D[u[x] p, x] + a[x] u[x] p f[z[x] u[x], x] a[x] u[x] z[x] + z[x] Derivative[1][u][x] + u[x] Derivative[1][z][x] Which formats as: $a(x) u(x) z(x)+z(x) u'(x)+u(x) z'(x)$


0

On the assumption that you have defined the functions u[x], a[x] and b[x] elsewhere, you can define a function as follows: f[x_] := u'[x] + a[x] u[x] + b[x] However, I recommend you read through the documentation on defining functions.


1

In response to your second question, "Is there a way to tell MMa to convert (for example) all the Hypergeometric functions into whatever Bessel function form it can?", execute $Post = FunctionExpand[#] & at the beginning of a Notebook to cause FunctionExpand to be applied to the output of each Cell after it is executed. However, be aware that $Post = ...


0

The thing that made this work in the end was using dummy variables as the function parameters. This then allowed me to use /. to replace variables. solution[mm_, gg_] := NDSolve[{eqn /. {m -> mm, g -> gg}, z[0] == 0, z'[0] == 0}, z[t], {t, 0, 10}] I think this is a pretty unintrusive solution, since it only affects one line of code and I can ...


1

You could define y to be an optional argument which will get the default value a when no value for y is supplied. f[x_, y_: a] := x^2 + y^2 {f[u, v], f[u]} {u^2 + v^2, a^2 + u^2}


0

Module is not necessary here, and is in fact the source of the problem: fTest1[f_] := Module[{w, x}, NMinimize[{f, 1 >= x >= 0, 1 >= w >= 0}, {x, w}]] fTest2[f_] := NMinimize[{f, 1 >= x >= 0, 1 >= w >= 0}, {x, w}] fTest1[x^2 - w^2] (* NMinimize::nnum errors and NMinimize[___] *) fTest2[x^2 - w^2] (* {-1., {x -> 0., w -> 1.}} ...


1

Not sure if this help or not but you can try it: fTest[f_, variables_] := Module[variables, NMinimize[{f, 1 >= x >= 0, 1 >= w >= 0}, {x, w}]] ans=fTest[y, {x, w}] (*1., {x$8300 -> 0., w$8300 -> 1.}}*) The easiest way I found is as follows: ToExpression[StringReplace[ToString[ans], "$" :> "+0*"]] (*{-1., {x -> 0., w -> ...


12

Your basic requirement is met with: safeExport[file_String, args___] := If[ ! FileExistsQ[file] || ChoiceDialog["File already exists. Overwrite?"], Export[file, args], $Failed ] What you describe as "attributes" (e.g. PlotRange -> All) are known as Options or named optional arguments. (See Attributes for a description of what that ...


4

ClearAll[eF] eF[z_: y] := Module[{j = 1, p = Partition[#, 2]}, First[Times @@ (z[Length@p] - p[[-1]]) Exp[Total[(Subtract[##] 2 z[j++] + {#-#2}^2) & @@@ p]]]] & Examples: ClearAll[a, b, c, d, e, f] eF[][{a, b, c, d}] (* E^((a-b)^2+(c-d)^2+2 (a-b) y[1]+2 (c-d) y[2]) (-c+y[2]) (-d+y[2]) *) eF[][{a, b, c, d, e, f}] (* E^((a-b)^2+(c-d)^2+(e-f)^2+2 ...


10

As was pointed out above, this is a good summary of Mathematica's constrained optimization methods. Read through this if you want to know a lot more. A quick answer is below: The answer to your question is strongly dependent on the function you want to maximize. Convex functions can be maximized quite easily, with the error controlled by the PrecisionGoal ...


2

I would do something like this: autoPTAtkHill[portionOfPT_, portionOfCT_, m_] := Module[{ptBlocks, ctBlocks, ctMatrix, ptMatrix, inversePTMatrix}, ptBlocks = Partition[stringToNumbers[portionOfPT], m]; ctBlocks = Partition[stringToNumbers[portionOfCT], m]; ctMatrix = {ctBlocks[[1]], ctBlocks[[2]]}; ptMatrix = {ptBlocks[[1]], ptBlocks[[2]]}; ...


0

Grid[Prepend[Transpose@{list1, list2}, {"Initial Vector", "Period"}], Dividers -> {2 -> True, 2 -> True}]


2

list1 = {{0, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 0}, {1, 1, 1, 1}}; list2 = {1, 5, 5, 5}; Grid[Prepend[Transpose[{Row[{"(", Row[#, ","], ")"}] & /@ list1, list2}], {"Initial Vector", "Period"}], Dividers -> {2 -> True, 2 -> True}] or Grid[Join[{{"Initial Vector", "Period"}}, Transpose[{Row[{"(", Row[#, ","], ")"}] & /@ ...


2

or NonlinearModelFit[]. With this function you can also extract the errors and other stuff.


1

Try FindFit[]. This function can fit a data set to arbitrary functions.


3

Observing the code reported in kguler's answer I note that it could be written more efficiently, if such an operation is desired. Specifically (f[#]->#)& cannot be compiled because the result is a Rule. It would be better to map f directly to the values, then use AssociationThread to construct the association. Proposal indexBy[f_][expr_] := expr ...


7

?? *`*IndexBy* Following the usual spelunking steps ClearAttrributes[IndexBy, {Protected, ReadProtected}] ?? IndexBy reveals the code that defines IndexBy. Simplifying (and ignoring argument type-checks) it is something like: indexBy[f_][expr_]:=Association[(f[#]->#)&/@If[AssociationQ[expr],Values[expr],expr]] indexBy[foo][Range[5]] (* ...


2

You can build your filter with UnitStep, Chop, or HeavisideTheta as mentioned in the comments to your question, f1[x_] := x UnitStep[x] f2[x_] := Clip[x, {0, x}] f3[x_] := x HeavisideTheta[x] All of these will give the same values when given the same arguments, but what of the cost? We don't want to be programmers who "know the value of everything but ...


1

Try this f[x_] := x*HeavisideTheta[x]; Have a look here: Plot[f[x], {x, -1, 1}] yields


0

I'm not sure I understand your question correctly, but a parallel line could look like and be constructed as follows. The interesting points: p1 = Plot[{f1, f2, f3}, {x, -5, 5}, PlotLegends -> "Expressions", Epilog -> {Red, PointSize[Large], Point[{{1, 0}, {-1, 2}, {-1, -2}, {-3, 0}}]}] And connected with a InfiniteLine infL = ...


1

Solve[{y == 1 - x, y == x - 1}, {x, y}] Solve[{y == 1 - x, y == x + 3}, {x, y}] seems the simplest approach. Another "overkill" region approach: l1 = InfiniteLine[{{0, 1}, {1, 0}}]; l2 = InfiniteLine[{{0, -1}, {1, 0}}]; l3 = InfiniteLine[{{0, 3}, {1, 4}}]; ri1 = RegionIntersection[l1, l2]; ri2 = RegionIntersection[l1, l3]; Reduce[RegionMember[ri1, {x, ...


3

Use Solve the neat way (and see here): Solve[{f1 == f2}, x] {* {x -> 1} *} Solve[{f1 == f3}, x] {* {x -> -1} *} Plot[{f1, f2, f3}, {x, -5, 5}, PlotLegends -> "Expressions", Epilog -> {Red, PointSize[Large], Point[{{1, 0}, {-1, 2}}]}]


3

Here it is an overkill but maybe for general context it is worth to say this. It does not work because fs are not regions: f1 = ImplicitRegion[{y == -x + 1}, {x, y}] f2 = ImplicitRegion[{y == x - 1}, {x, y}] Solve[{k \[Element] f1, k \[Element] f2}, {k}] {{k -> {1, 0}}} I said an overkill because people usually do something like: Solve[{y == -x ...


3

As Sjoerd points out, a good place to start is by recognising that the line from the ant to the tip of the grass must be a tangent to the curve. So you can solve for the x positions of the ant where this is true: antx = x /. NSolve[(8 - f[x])/(32 - x) == f'[x], x, Reals] (* {14.9475, 8.62026} *) Here's a plot showing those points and the line-of-sight to ...


4

This may help Hillheight[x_] := (1/16 x^2 - 2 x + 80)/(1/16 x^2 - 2 x + 20)^2 Hill = Plot[(1/16 x^2 - 2 x + 80)/(1/16 x^2 - 2 x + 20)^2, {x, 0, 32},PlotRange -> {0, 8}]; BladeofGrass = ParametricPlot[{32, 1/5 + x}, {x, 0, 39/5}, PlotStyle -> {Green}]; line[xANT_, x_] := InterpolatingPolynomial[{{xANT, Hillheight[xANT]}, {32, 8}}, x]; ...


2

Not sure I understood it properly. Instead of Animate, looking at slope variations plots may also help determine points near tangency. f[x_]=(1/16 x^2-2 x+80)/(1/16 x^2-2 x+20)^2; Hillheight[x_]:=(1/16 x^2-2 x+80)/(1/16 x^2-2 x+20)^2; Hill=Plot[Hillheight[x],{x,0,32}] BladeofGrass=ParametricPlot[{m/5+x, m x },{x,0,35},{m,.05,0.5},PlotStyle->{Green}]; ...


1

As per the answer from kguler - the following works: Inner[LogLikelihood[#,{#2}]&,Custom[vData],vData]


1

I don't see how your definition works as written. I get SetDelayed::write: Tag Function in Function[d_,σ_] is Protected because Function is built-in syntax. Maybe you had the function called something else in your code and renamed it for posting here? If so, please don't do that; make sure the code you post actually works. Anyway, you don't ...


4

Thanks Mr.Wizard. I've filed a bug for this, #288440 if you have future correspondence with people inside the company about it...


3

f[d_, σ_, x_] := Module[{h, ϵ0, m, e0, α, κ, β, a, ϕ, e, n}, h = 6.62606957*10^(-34); ϵ0 = 8.8541878176*10^(-12); m = 9.10938291*10^(-31); e0 = 1.6*10^(-19); α = (3/ 5 2^(-1/3) (3/π)^(2/3))*((ϵ0* h^2)/(m*(e0)^(5/3)))*(d^(-5/3)*σ^(-1/3)); κ = (5*α/3)*(1/2)^(2/3); β = 4/(κ^(3/4)*Sqrt[5]); a = 4/(β*Sinh[β/2]); ϕ = (Cosh[β (0.5 - x)])/(β* ...


1

Functions should be defined as follows: MyFunc[A_, B_, C_, 1] := 3 x - 2 y; MyFunc[A_, B_, C_, 2] := 8 x - 4 y; Then NewFunc[A_, B_, C_] := Sum[MyFunc[A, B, C, i], {i, 1, 2}] evaluates properly. NewFunc[1, 1, 1] (* 11 x - 6 y *)


2

IMHO this is a Bug. You can prevent the error message in V10 using Quiet: series = Range[5]; MovingMap[Quiet[#[[2]]/#[[1]] - 1 &], series, {2}] You can also use Internal`PartitionMap, without Quiet: Developer`PartitionMap[#[[2]]/#[[1]]-1&, Range@5, 2, 1] {1,1/2,1/3,1/4} Post about PartitionMap


5

This appears to be a bug in MovingMap. The function is applied beyond the left edge of the list and then the result is discarded: echo[x_] := (Print[x]; x) MovingMap[echo, Range@5, {2}] {0,1} {1,2} {2,3} {3,4} {4,5} {{1, 2}, {2, 3}, {3, 4}, {4, 5}} I can see no reason to use the padding element 0 here. Interestingly when one ...


4

{l1, l2} = {{1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}} MapThread[DirichletConvolve[n, #1, n, #2] &, {l1, l2}] (* {1, 3, 4, 7, 6, 12, 8, 15, 13, 18} *)



Top 50 recent answers are included