Hot answers tagged

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


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.


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[]}} *)


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


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


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


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


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


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.


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


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_}], ...


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}} *)


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


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


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


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


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


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.


3

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


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


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


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


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


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


2

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


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.



Only top voted, non community-wiki answers of a minimum length are eligible