Tag Info

New answers tagged

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]) *) ...


0

In the question you compare the patterns f[s__] and f[s_Sequence]. Note that these are different patterns: FullForm[f_Sequence] (* Pattern[f, Blank[Sequence]] *) FullForm[f[s__]] (* Pattern[s, BlankSequence[]] *) As the comments point out, Blank[Sequence] would be matched by an expression with head Sequence, but Sequence automatically disappears during ...


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 ...


1

The reason is that you have an inefficient inner loop when you use myBBBlik. Every time you call myBBBlik, it takes a certain amount of time to calculate the result (on my computer, about 1/2 second of mucking around because your likelhood function is a bit complex). But myBBBlik2 creates an algebraic expression once (?or twice?) and can substitute the ...


4

In the Standard Evaluation Sequence the heads of expressions are evaluated first: If the expression is a raw object (e.g., Integer, String, etc.), leave it unchanged. Evaluate the head h of the expression. Evaluate each element of the expression in turn ... Therefore since f[1] is the head of f[1][2] it will evaluate if it has a definition that matches. ...


3

SeedRandom[42]; m1 = .5; m2 = 0; m3 = 0; m4 = .5; n1 = .5; n2 = 0; n3 = 0; n4 = .5; k1 = .5; k2 = 0; k3 = 0; k4 = .5; F = {({{m1, m2}, {m3, m4}}.# + {0, 0}) &, {{n1, n2}, {n3, n4}}.# + {1/2, Sqrt[3]/2} &, {{k1, k2}, {k3, k4}}.# + {1, 0} &}; ListPlot@NestList[RandomChoice[F][#] &, {1, 1}, 1000]


1

Maybe obvious but if you want to test if $z$ represents an integer you can use: Assuming[z \[Element] Integers, Simplify[z \[Element] Integers]] This gives True


5

Basically IntegerQ is for determining whether the object inside it is an integer, not whether it represents an integer. Since z is a Symbol, we get False. As for your function, I'm assuming you're using some variant of If[EvenQ[z], ___]. As you said, this won't work because EvenQ will always return False on a symbol since z does not have head Integer. ...


3

According to the documentation (ref/IntegerQ): IntegerQ[expr] returns False unless expr is manifestly an integer (i.e. has head Integer). [emph added] Evidently the assumption does not make z an actual integer, that is, an expression whose head is Integer.


7

I believe the first part of your question is answered by Stack. Observe: g := Stack[] something[f1[g], f3[g]] something[f1[{something, f1}], f3[{something, f3}]] So you can find that g was evaluated in f1 or f3 and further that these were evaluated in something. However this should not be necessary for your Ticks application. The value of Ticks ...


2

If you have need of individually addressing the parameters by name you could use: δ = {δ1, δ2, δ3, δ4, δ5}; γ = {γ1, γ2, γ3, γ4, γ5}; Quiet[toPattern[s_Symbol] := s_] foo[toPattern /@ δ, toPattern /@ γ] := {δ3/γ1, δ4/γ3, δ5/γ5} Check: ?foo Global`foo foo[{δ1_,δ2_,δ3_,δ4_,δ5_},{γ1_,γ2_,γ3_,γ4_,γ5_}] := {δ3/γ1, δ4/γ3, δ5/γ5} foo[{1, 3, 5, 7, 9}, ...


3

As mentioned in my comment I would not recommend to do what follows except for certain special cases and I'm almost sure that there is a better solution for your actual problem than this. Nevertheless, what you ask for can be done like this: Nobs = 10; d = Symbol[#] & /@ Table["d" <> ToString[i], {i, 1, Nobs}]; g = Symbol[#] & /@ Table[ "g" ...


2

Define your function with list variables and be sure that your function definition on the right-hand side applies to lists (as in this case of Total). f[x_List, y_List] := Total[x] Total[y]; f[{3}, {4}] (* 12 *) f[{3, 6}, {4}] (* 36 *) f[{3, 6}, {4, 2, 1}] (* 63 *)


0

I'm not sure whether the following will fulfill all of your requirements as it does make a copy of the part which is to be shown. But that copy is only used to control when updates are needed and only within a purly local variable. This should not be a problem concerning the updating of the original symbol, but in case you are concerned about the memory ...


2

While Kuba's answer is simpler, what you asked for can be accomplished also rather easily with the help of the nested injector pattern: variables /. {vars__} :> (Map[Pattern[#, Blank[]] &, {vars}] /. {patts__} :> (f[{patts}, x_] := g[vars, x]))


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 -> ...


3

I think this approach is an overreaction. Maybe something like this will be ok? f[l_, x_] := g[##, x] & @@ l


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 ...


2

Have managed to get sn improvement in the method given in the OP using rasher's reveltation in this chat session & Mr.Wizard's removeFrom subs[num_, list_] := DeleteDuplicates[Sort[#] & /@ Select[Subsets[list], Total@# == num &]] removeFrom[b_List, a_List] := Module[{f}, f[_] = 0; (f[#] = -#2) & @@@ Tally[a]; Pick[b, UnitStep[f[#]++ & ...


1

You could try efunc[t_] := Exp@Total@((#[[2]]^2 - #1[[1]]^2) & /@ Partition[t, 2]); Where t is a list with an even number of elements.


2

This is a partial answer that offers two solutions that you might be happy with. First, you are asking for the minimum number of cliques that cover all the edges of $G$ such that each edge is in exactly one clique. This is known as the clique covering number, denoted by $\text{cc}(G)$. The minimum number of cliques that cover all the edges of $G$ such that ...


3

This is not (at this time) a direct answer to the core question, perhaps better thought of as a placeholder. Nonetheless, it will serve as an example of how to speed up this problem, and like things in general. You need to start thinking in "Mathematica" terms. That is, whenever possible, think of how you might manipulate things en masse, as operations on ...


1

I'll use your example Theta: Theta[y0_, y1_, y2_, s_, d_] := Total[(Exp[-#] (# + 1)^10) & /@ {y0, y1, y2, s, d}]; f[y0_, y1_, y2_, s_, d_] := (Pause[1]; Log[Theta[y0, y1, y2, s, d]/constant]* Theta[y0, y1, y2, s, d]/D[Theta[y0, y1, y2, s, d], y0]); To force evaluation first, use = instead of :=, like so: f0012[y0_, y1_, y2_, s_, d_] = ...


0

You can play with patterns for f. Here is alternative approach: Function[expr, Block[{g}, Block[{f, h}, SetAttributes[h, Orderless]; f[x___] := (g @@ (h @@ (h @@@ Partition[{x}, 2]))) /. {h[y_, y_] -> Sequence[], h -> Sequence}; expr ] /. g -> f ] ][ f[1, ...


0

If you test the code above, i.e. run mySetVar[t] it works correctly (i.e. var is set to 20). The problem is actually one of "Definition" rather than SetDelayed. Definition is a weird function that simply prints some info to the screen. In this case, it gets it wrong, i.e. there is a bug in Definition. As a work around, if you want authoritative ...


4

There are a few constructs which are not evaluated in the standard way in Mathematica. Unevaluated and Sequence are like this. When Mathematica evaluates an expression, it will first walk through it and strip out any Sequence expressions, leaving only the body. This is a special step done during evaluation. In[]:= On[] f[Sequence[1, 2, 3]] Off[] During ...


6

Re your Idea 2: Both f[s : (_) ..] := Plus[s] f[1,2,3] ( 6 *) and f[s : _ ..] := Plus[s] f[1,2,3] (* 6 *) work as expected. Without space or parentheses separating _ (Blank) from .. (Repeated), both (_..) and _.. are parsed as _. (i.e. Default, which represents an argument that can be omitted - see Default) followed by . which is bad syntax as ...


4

Analysis Function is left-associative as converting to StandardForm reveals: (((f[#1] &) /@ f[#1] &) /@ f[#1] &) /@ {a, b, c} You can see the result of the rather odd operation with: f = {#, "x"} &; f[#] & /@ f[#] & /@ f[#] & /@ {a, b, c} {{{{a, x}, {x, x}}, {{x, x}, {x, x}}}, {{{b, x}, {x, x}}, {{x, x}, {x, x}}}, {{{c, ...


0

I am not sure which from of the solutions you are looking at but you can try this: f = #+1&; Composition[Sequence @@ ConstantArray[f, 2]][f[#]] & /@ {a, b, c} (*{3 + a, 3 + b, 3 + c}*) how about this: Nest[Map[f, #,{-1}] &, f[#], 2] & /@ {a, b, c}


1

Although achieving the desired output requires only minor modifications to the Module, I provide it here in a modestly more compact form: pollardrho[n_] := Module[{x = 2, y = 2, d = 1}, g[x_] := Mod[x^2 + 1, n]; While[d == 1, x = g[x]; y = g[g[y]]; d = GCD[Abs[x - y], n]]; If[d == n, "Null", d]] pollardrho[2896753] (* 1229 *) pollardrho[17] (* Null ...


2

To me the question is more about calculating the function than generating the plot. Given an equation that cannot be solved symbolically, we can approximate the implicit function with NDSolve. (There are several examples on this site., e.g., Getting an InterpolatingFunction from a ContourPlot, Plotting implicitly-defined space curves.) ...


3

My preferred method would be using @rahul's Mesh trick. You can also use the option Exclusions as follows: f[x_, y_] := x + y g[x_, y_] := Exp[x y] - y; ParametricPlot[{y, f[x, y]}, {x, -5, 5}, {y, -5, 5}, Frame -> False, PlotRange -> All, BoundaryStyle -> None, Mesh -> None, PlotStyle -> None, Exclusions -> {g[x, y] == 0}, ...


1

You can also eliminate the implicit dependency by using Solve, e.g.: res=Solve[Exp[x y]==y,x][[1,1]]/.C[1]->0 and apply the result to the output function: x+y/.res or combine the steps into one: x+y/.Solve[Exp[x y]==y,x][[1,1]]/.C[1]->0 (* y+Log[y]/y *) This way, you end with the desired function of y only, may use standard plotting, and of ...


1

If post processing is acceptable then: ContourPlot[Exp[x y] == y, {x, -5, 5}, {y, -5, 5}, Frame -> False, Axes -> True] /. GraphicsComplex[a_, b___] :> GraphicsComplex[({#2, #2 + #1} &) @@@ a, b]


4

f[x_, y_] := x + y g[x_, y_] := Exp[x y] - y; ParametricPlot[{y, f[x, y]}, {x, -5, 5}, {y, -5, 5}, MeshFunctions -> {Function[{a, b, x, y}, g[x, y]]}, Mesh -> {{0}}, PlotStyle -> None, BoundaryStyle -> None, MeshStyle -> {{Opacity[1], Thick, Black}}, PlotRange -> All, Frame -> False]


5

If interested in the evolution of this, read on, otherwise, skip to near the bottom for latest iteration... Give this a whirl, ran fine on a junky old netbook with 1 Gig that I keep at the local cigar shop: var = 10 pow = 12 result = With[{ar = Array[x, var]}, CoefficientArrays[Tr[ar^2]*Tr[ar]^pow][[-1]] // ...


4

Frankly I'm not sure what you're trying to do, but as a starting point: Tr[#^2]*Tr[#]^8 & @ Array[x, 10] CoefficientRules[%] ~Short~ 5 (x[1] + x[2] + x[3] + x[4] + x[5] + x[6] + x[7] + x[8] + x[9] + x[10])^8 (x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 + x[5]^2 + x[6]^2 + x[7]^2 + x[8]^2 + x[9]^2 + x[10]^2) ...


8

Basics To get it out of the way, for the specific example given you could use Unevaluated: Cases[Unevaluated[1 + 3], _, {-1}] {1, 3} To actually be able to modify a System function I recommend Internal`InheritedBlock: SetAttributes[cases, HoldAll] cases[args___] := Internal`InheritedBlock[{Cases}, SetAttributes[Cases, HoldFirst]; ...


1

Dimensions>>Generalizations and Extensions says: Dimensions works with any head,not just List. So, Dimensions[foo[x,y]] (* {2} *) and foo[[1]] (* x *) foo[[2]] (* y *) In your case, checking the FullForm of χ[z] FullForm[χ[z]] gives Times[Plus[-1,Power[z,2]],Power[Plus[1,Power[z,2]],-1]] Thus, χ[z][[0]] (* Times *) χ[z][[1]] (* -1 + z^2 ...


0

Remove["Global`*"] pcafunct[X_, k_] := Module[{dim, m, n, mn, X1, cv, phi0, lambda, phi}, dim = Dimensions[X]; m = dim[[1]]; n = dim[[2]]; (*Compute dimensions of input matrix X*) mn = List /@ Mean[X]; X1 = X -ConstantArray[1, {m, 1}].Transpose[mn]; cv = Transpose[X1].X1/m; phi0 = Eigenvectors[cv]; lambda = Eigenvalues[cv]; phi = phi0[[1 ;; k, 1 ;; n]]; phi ...


2

You are getting a few things about Mathematica syntax wrong. First you want to not use the underscore in variable names. Also, you can't reassign X when X is your function variable. Finally you have to use [[]] to get the elements of a list. pcafunct[X_, k_] := Module[{Dim, m, n, mn, ones, Cv, phi0, lambda, phi, X1}, Dim = Dimensions[X]; m = ...


0

Does it not work as written? Del = {D[#, x], D[#, y], D[#, z]} &; ∇f[x, y, z] $\left\{f^{(1,0,0)}(x,y,z),f^{(0,1,0)}(x,y,z),f^{(0,0,1)}(x,y,z)\right\}$ To extend this in the way that I believe you want you can use the Notation Package. First: Needs["Notation`"]; Then paste and evaluate: Cell[BoxData[ RowBox[{"Notation", "[", ...



Top 50 recent answers are included