# Tag Info

## New answers tagged function-construction

1

I think you need "InlineCompiledFunctions" -> False: f = With[{bigNastyFunction = Compile[{{y, _Complex}}, Sin[y](*,CompilationTarget\[Rule]C*)]}, Compile[{{x, _Complex}}, bigNastyFunction[x] + bigNastyFunction[x^2]^2 + 3 bigNastyFunction[x^3], CompilationOptions -> {"InlineCompiledFunctions" -> False}]] …… 1 C1 = ...

2

Here is one way: With[{opts = SystemOptions[]}, With[{bigNastyFunction = Function[{y}, Sin[y]]}, Internal`WithLocalSettings[ SetSystemOptions["CompileOptions" -> "CompileReportExternal" -> True], f = Compile[{{x, _Complex}}, bigNastyFunction[x] + bigNastyFunction[x^2]^2 + 3 bigNastyFunction[x^3]], SetSystemOptions[opts] ]]] ...

0

As a general rule, you can only call a function f from inside a Compile'd function c if f is also compiled or is a built-in numerical Mathematica function. The solution I would suggest is to make bigNastyFunction a compiled funciton: bigNastyFunction = Compile[{{x, _Complex}}, Sin[x]]; Then call it from your function: f = Compile[ {{x, _Complex}}, ...

0

Nice idea. I give this example to my 3rd year students—essentially Heisenberg's matrix mechanics. Just a minor comment; you can use Dot instead of Total: reduceHO[n_]:= Module[ {a=SparseArray[{Band[{1,2}]->Sqrt[Range[n]]},{n,n}+1]}, ((SuperDagger["a"])^Range[0,n]/Sqrt[Range[0,n]!]) . MatrixPower[a+Transpose[a],n].UnitVector[n+1,1]]

0

How about Replace[poly, {_Rational -> 1, x^_. -> 1}, {1}] This line assumes that the overall prefactors are rationals (but you could easily add _Complex if needed) and that the head of poly is indeed Times.

4

It's not entirely well defined due to handling of numbers, but the following should be at least close to what's wanted. poly1 = 1/64 (3 c^2 e - f^2 - x) (c^2 (4 e + b^2 g) - 4 (f^2 + x))^2 (c^2 (4 e + (a^2 + b^2) g) - 4 (f^2 + x)); poly2 = -(1/64) (b^2 c^2 - 4 x)^2 (a^2 c^2 + b^2 c^2 - 4 x) x; poly3 = x^42 (-(1/2) c^2 d^2 + x)^6; ...

2

This does not answers my own question fully (I am still interested to see if someone might come up with an truly elegant solution based on DownValues) but I found a rule-based solution that is imho. elegant non the less. fizzbuzz[rls_]:= With[{res=ReplaceList[#, rls]}, If[res=={}, #, StringJoin@res]]& fizzbuzz[{_?(Mod[#,2]==0&) -> "Fizz", ...

3

An alternative approach It seems at its heart that you want more than one rule to match a given expression and each match to return a value, which is then to be combined. I cannot think of any "clever" method to do this that is not contrived and questionable. Perhaps something more standard has at least some service for you. Your rules, each one in a ...

6

In keeping with the multiple DownValues part of the question, this is an option: ClearAll@f conditions[x_] := {Mod[x, 2] == 0, Mod[x, 3] == 0, x < 10} f[x_ /; Or @@ conditions[x]] := StringJoin@Pick[{"Fizz", "Buzz", "Zapp"}, conditions[x]] f[x_] := x It tests for any of the conditions first, and then within the body of the function uses the individual ...

0

Perhabs g[x_] := Switch[{Mod[x, 2] == 0, Mod[x, 3] == 0, x < 10}, {True, True, True}, "FizzBuzzZapp", {True, True, False}, "FizzBuzz", {True, False, True}, "FizzZapp", {True, False, False}, "Fizz", {False, True, True}, "BuzzZapp", {False, True, False}, "Buzz", {False, False, True}, "Zapp", _, x] Not sure about elegance but at ...

2

f[x_] := With[{res = f1[x] <> f2[x] <> f3[x]}, Switch[res, "", x, _, res]] f1[x_?(Mod[#, 2] == 0 &)] := "Fizz" f1[x_] := "" f2[x_?(Mod[#, 3] == 0 &)] := "Buzz" f2[x_] := "" f3[x_?(# < 10 &)] := "Zapp" f3[x_] := "" f /@ Range@15 {"Zapp", "FizzZapp", "BuzzZapp", "FizzZapp", "Zapp", "FizzBuzzZapp", "Zapp", ...

7

Just as a quick an dirty start, I would try this: $maxStep = 3; (* or what you believe necessary *)$eps = 0.001; (* some limit to tell that l and m are now sufficiently close *) ClearAll[f]; f[l_, m_, d_, $maxStep ] = l / (l + d); (* end by maxStep *) f[l_, leps_, d_, _ ] /; l <= leps < l +$eps = l / (l + d) (* end by l approx equal m *) ...

1

Try fulleq=Append[eqnsMain, eqnsAdd]; And then Eliminate[fulleq, c] Using the {} parenthesis to fuse them would require Flatten on the result, as Mathematica will combine the vectors, not their components.

1

There are basically two errors in your code: misplaced semicolons and not initializing n at the right point of the code. Also, I think it would good if you allowed the free variable to passed to f, rather than hard wiring it into f. f[x_?NumericQ, z_Symbol] := Module[{n, m = 1, output = 0, y}, While[m < 5, n = 1; While[n < 5, y = ...

1

As mentioned in the comments you are not suppressing the output of the While statements with a semicolon. However, you still will not get the result you are expecting because you have scoped z inside of Module and your output will return a variable that is no longer in scope (a Unique variable from the Module). An example of a Wolfram Language way of ...

0

This did turn out somewhat clumsy, but it avoids the n! complexity of Permutations f[c_, {}] = c; f[c_, s_] := g[c, First[s], Rest[s]] g[c_, a_, b_] := Sequence @@ MapIndexed[f[Append[c, {a, #}], Delete[b, First[#2]]] &, b] h[L_] := {f[{}, L]} h[{a, b, c, d, e, F}] (*{{{a, b}, {c, d}, {e, F}}, {{a, b}, {c, e}, {d, F}}, {{a, b}, {c, F}, {d, e}}, {{a, ...

3

Some of these could be implemented differently, of course, but I've gone the way of making all of them pure functions (in the Mathematica sense). Every single one takes a Sequence of arguments as the inputs, but some of them accept function names as inputs first, and the projection function accepts an integer for which argument is chosen (I have chosen to ...

0

Functionally, this definition of f works the way I think you're trying to describe your needs: f[data_, x_] := Interpolation[Table[{h[i], data[[i]]}, {i, 1, Length[data]}], x]; Though, I have reservations about this method with large data vectors because it requires interpolating for every x that's plotted. It'd be better to to create the ...

3

With WolframLanguageData your list of graphics primitives will stay up to date. ListOfGraphicsPrimitives[] = Symbol /@ WolframLanguageData[ EntityClass["WolframLanguageSymbol", {"FunctionalityArea","GraphicsPrimitiveFunctions"}], "Name"] {AASTriangle, AffineHalfSpace, AffineSpace, Annulus, Arrow, ASATriangle, Ball, BezierCurve, BSplineCurve, ...

3

Instead of pattern-matching the expressions you want to keep, you could also remove the ones you do not want to keep: myfunc[Replace[expr,x_ /; Not@MemberQ[{a, d}, Head@x] -> Sequence[], {1}]] This approach should be faster than using pattern matching using multiple blanks. It also works with other expression heads than Times.

5

Instead of using BlankSequence, use PatternSequence: expr /. Times[rest___, subExpr : PatternSequence[___a, ___d]] :> myfunc[Times[subExpr]] myfunc[a[x, r] a[y, 1] d[w, m]] The orderlessness of the pattern sequence is ensured by the Orderless attribute of Times.

4

Update for speed It was slightly slower then bb in the OP so I tweaked it a bit. It used to use Function[{x}, Select[SubsetQ[#, x] &]@s] /@ s but the new Function in g below, although bigger, completes in $\frac{4}{5}$ the time than bb. Now, on my machine: First@AbsoluteTiming[g[Range[11]];] (* 17.6471 *) First@AbsoluteTiming[bb[Range[11]];] (* ...

4

How about f = With[{s = Subsets[#], r = Subsets[Range@Length@#]}, Pick[s, #] & /@ Outer[SubsetQ[#2, #1] &, r, r, 1]] & f[{1, 1, 2}] // Column (* {{},{1},{1},{2},{1,1},{1,2},{1,2},{1,1,2}} {{1},{1,1},{1,2},{1,1,2}} {{1},{1,1},{1,2},{1,1,2}} {{2},{1,2},{1,2},{1,1,2}} {{1,1},{1,1,2}} {{1,2},{1,1,2}} {{1,2},{1,1,2}} {{1,1,2}} *)

5

linearizeEquation[expr_, f_, fp_, order_] := Block[{e}, Expand@Normal@Series[expr /. f -> (fp + e dF[#] &), {e, 0, order}] /. e -> 1 ] linearizeEquation[f[x] + (1 - f[x]^2) + D[f[x], {x, 2}] + f[x] D[f[x], x], f, f0, 1] (* 1 + f0 - f0^2 + dF[x] - 2 f0 dF[x] + f0 dF'[x] + dF''[x] *)

1

I decided to do this in the old-fashioned procedural way. collatz[k_Integer?OddQ] := 3 k + 1 collatz[k_Integer?EvenQ] := k/2 collatzIter[k_ /; k > 2, n_: 125] := Module[{i = 0, c0 = k, c1}, While[++i < n, c1 = collatz[c0]; If[c1 < 2, Break[]]; c0 = c1]; {i, c1}] Module[{m = 2, r = {0, 0}}, While[r[[2]] <= 4, r = ...

4

There are many questions about the Collatz sequence on this site, for example here. I interpret your question to ask for the smallest integer n that, after 125 iterations, has not settled into the 4-2-1 loop that is conjectured to terminate all Collatz iterations. You can run 125 iterations and return the result with the following definition. ...

1

There are several ways to do what is asked. Below I am going to use Table since that is close to the use of the For loop in the question. First we define the function f and vector v: f[t_] := Sin[t] v = Range[1, 6]; Next we define a function that is the sum of f over the offsets given in v: T[t_] := Evaluate[Total[Table[f[t - i], {i, v}]]] This is the ...

4

(1) The time difference comes from the way fnm is evaluated differently. In the first code block, you evaluate fnm at every step in the Table in table1, and then you take parts of it, but you only need to evaluate it once as it does not depend on any of the iteration variables n1,m1,n2. This is what you do in the second code block: you calculate the fnm ...

11

The trick is thinking about list structural operations, not indexes like you would do in common procedural languages. The following does the same as your code, but is terser and easier to follow lint = {3, 2, 2}; lx = {a, b, c}; idx = Tuples[Range[0, #] & /@ lint]; dd = BIF[p[#][lx (1 - Unitize[lint - #])], Transpose@{lx, lint - #}] & /@ idx ...

3

With Mathematica 10, you can also do this by Activate@Table[Inactivate[a[[i]]*Sin[#] &], {i, 3}]

0

When you define your function like this, then e.g. ffd[.5, .5, .5] is really D[ff[.5, .5, .5], {{.5, .5, .5}}]. to avoid scoping issues with x=5; ffd[x_, y_, z_] = D[ff[x, y, z], {{x, y, z}}] you can use ffd = Evaluate[D[ff[#, #2, #3], {{#, #2, #3}}]] & & means there is a held Function so we have to use Evaluate to force computation of ...

1

With ffd[x_,y_,z_]:= D[ff[x,y,z],{{x,y,z}}] the values of x, y, and z are substituted as arguments causing differentation wrt. numbers, i.e. nonsense. Moreover, you are using SetDelayed, which differentiate once for every call, which rather should be once for all time. The solution to both problem is replacing SetDelayed with Set: ffd[x_,y_,z_]= ...

4

Thanks a lot for Kuba's hints and his answer, I written down my understanding. Using two defintions: CAGDBSplineFunction[pts_, opts : OptionsPattern[]]:=, the user should use this definition. CAGDBSplineFunction[pts_, {deg_, knots_}]:=, which returns the object. CAGDBSplineFunction /: MakeBoxes[ obj : CAGDBSplineFunction[pts_, {deg_, knots_}], ...

5

So, extending comments. Quick fix is to use Return[$Failed, Module] here but it's not the right approach. This SplineDegree should not reach MakeBoxes at all. Here's what should be done. Imo, the user should not use CAGDBSplineFunction manually to create it, like in case of InterpolatingFunction it is created by something else, here Interpolation. So in ... 6 So many ways: Apply[Unique, (patt :> #) & @ Table[{}, {3}], {2}] (patt :> Evaluate@Table[foo[], {3}]) /. foo -> Unique Hold[Unique[]][[Range[3]^0]] /. _[x__] :> (patt :> {x}) (patt :> {##}) & @@ Table[Unevaluated @ Unevaluated @ Unique[], {3}] (Function @@ {patt :> Evaluate@Table[#[], {3}]}) @ Unique All produce: patt ... 6$userInt = 5; With[{ x = Table[Inactive@Unique[], {i, $userInt}] }, rules = {_Integer :> x} // Activate ] {_Integer :> {Unique[], Unique[], Unique[], Unique[], Unique[]}} {1} /. rules {{$27, $28,$29, $30,$31}}

9

This can be a good case for a Block trick: Block[{Unique}, With[{x = Table[Unique[], {i, 1, 3}]}, rules = {patt :> x}] ] (* {patt :> {Unique[], Unique[], Unique[]}} *)

3

With[{x = Table[HoldForm@Unique[], {i, 1, 3}]}, rules = {patt :> x}] patt /. (ReleaseHold@rules)

2

The simple issue you are having is that u and f retain their values from the previous evaluation of testFn. You either need to initialise them each time in the body of the function, or (better) create local variables so that your result doesn't depend on how many times you evaluate testFn. I wouldn't ordinarily recommend the use of loops to do anything ...

11

The simplest way is simply to define the two-argument case, f[var1_, var2_] := ... and then the one-argument case as f[var1_] := f[var1, g[var1]] Of course, if things get fancy, this sort of scheme will stretch but it can eventually break. For more flexible uses, see Leonid Shiffrin's answer to this similar question.

6

Maybe you can use the following: ClearAll[dmydot, mydot] Derivative[ndiff__][mydot][x__] := dmydot[ndiff][x]; dmydot /: Times[f__, dmydot[n1___, 1, n2___][x__]] := mydot @@ MapAt[Times[f] &, {x}, Length[{n1}] + 1] All I'm doing here is pull the inner derivative that came from the chain rule back into the mydot to replace the original entry at that ...

2

vovels = {"a", "e", "i", "o", "u"}; dic = DictionaryLookup[{"Spanish", All}]; Length@dic 86016 5 vowels in any order AllVowelsQ[str_String] := FreeQ[Map[StringFreeQ[str, #] &, vovels], True] {Length@#, #}&@Select[dic, AllVowelsQ] // Short Repeated vowels RepeatedVovelsQ[str_String] := Max@Map[StringCount[str, #] &, vovels] ...

Top 50 recent answers are included