# Tag Info

12

There are nice trigonometric formulas δ = 0.01; trg[x_] := 1 - 2 ArcCos[(1 - δ) Sin[2 π x]]/π; sqr[x_] := 2 ArcTan[Sin[2 π x]/δ]/π; swt[x_] := (1 + trg[(2 x - 1)/4] sqr[x/2])/2; Plot[{TriangleWave[x], trg[x]}, {x, -2, 2}, PlotRange -> All] Plot[{SquareWave[x], sqr[x]}, {x, -2, 2}, PlotRange -> All, Exclusions -> None] Plot[{SawtoothWave[x], ...

8

When tracing other plots, I often saw that plotting-related functions compile their arguments when possible. A quick look at the trace of your example suggests the same, because the Exp function is used only for the evaluation of function. This seems to indicate that your second argument Exp[-9 t^2] was already compiled down and doesn't show up when the ...

8

You can specify the evaluation of which construct should be stopped by Return by providing the second argument (undocumented?). For example, Scan[Function[x, Module[{}, Print[x]; Return[$Failed, Module]; Print[-x]]], {1, 2, 3}] or Scan[Function[x, Print[x]; Return[$Failed, CompoundExpression]; Print[-x]], {1, 2, 3}]

7

It's hard to reply without larger context, but if you are not restricted to use pure functions, then one option would be to use the pattern-defined overloaded function instead: ClearAll[fun]; fun[2] := Null; fun[x_] := ((*Do something useful*)Print[x]) Then, you just write: Scan[Function[x, Scan[fun, x]], {{1, 2, 3}, {4, 5, 6}}] In fact, you can as ...

7

The problem arises when function returns a number smaller than $MinMachineNumber: function[t_] := Exp[-9 t^2]; LogLogPlot[function[t], {t, 8.8718, 8.872}, PlotRange -> All, GridLines -> {{{Sqrt[Log[1/$MinMachineNumber]]/3, Directive[Thick, Dashed]}}, None}] Show[%, Ticks -> Automatic] For some reason LogLogPlot considers numbers smaller ...

7

One approach is to convolve the sawtooth wave directly with a Gaussian kernel. Since this can be done analytically, it is possible to return a function that is in closed form and hence can be differentiated without interpolation. f = Integrate[SawtoothWave[t/10] Exp[-3 (t - x)^2] , {t, 0, 50}] Plot[f, {x, 0, 50}] You can control the amount of "rounding" ...

5

This is probably not going to be the best answer but offering it as an opener or as a guide to towards a better solution Setting your initial input as a function f[n_]:=Length[Select[IntegerPartitions[10],First[#]==n&]] then Map[f,Range[10]] {1, 5, 8, 9, 7, 5, 3, 2, 1, 1} No doubt regular contributors can improve on this

3

There is a nice combination of Prime and PrimePi: count3[n_] := Sum[1, {i, PrimePi[n]}, {j, i, PrimePi[n/Prime[i]]}, {k, j, PrimePi[n/Prime[i]/Prime[j]]}]; count3[100000.] // AbsoluteTiming {0.157486, 25556} It is ~30 times faster: Omega3Count[100000] // AbsoluteTiming {4.445524, 25556} Update A general solution (with Coolwater's ...

3

To transform back from spherical tensors to Cartesian tensors, the unitary transform is \mathbf{U}_l = \frac{1}{\sqrt{2}}\left\{ \begin{align} Y^{-m}_l + (-1)^m Y^m_l &,\ m >0\\ \sqrt{2} Y^0_l &,\ m=0\\ i(Y^{-m}_l - (-1)^m Y^m_l) &,\ m<0 \end{align}\right. where $m$ runs from $-l$ to $l$. This can be built in many ways, usually ...

3

I usually set up a wrapper function that transforms if input is valid and otherwise acts like Identity: pickyTransform[expr_] := 0 helper[expr_] /; ! AtomQ[expr] && FreeQ[expr, _?NumericQ] := pickyTransform[expr] helper[expr_] := expr FullSimplify[a^3 + x^y, TransformationFunctions -> {helper}] (* a^3 *) This works fine most of the time, but ...

2

I found same answer as ybeltukov, but a little improvment using cubic root (i see now the difference is actually significant (130 times faster than omega3count)): co2[k_]:=Sum[1,{n,PrimePi[Power[k, (3)^-1]]}, {m,n,PrimePi[k/Prime[n]^2]},{l,m,PrimePi[k/(Prime[n]Prime[m])]}] Result: Timing[Omega3Count[310123]] {14.383000000000001`,78591} Versus ...

2

I would use Catch and Throw if pressed to choose, without the 'exit' : Scan[Function[x, Scan[Function[y, Catch[If[y == 2, Throw[Null]]; (*Do something useful*) Print[y]] ], x]], {{1, 2, 3}, {4, 5, 6}}] or simply, Scan[Function[x, Scan[Function[y, If[y == 2, Null, (*Do something useful*) Print[y]] ], x]], {{1, 2, 3}, ...

2

Artes's solution is the most general one that works for numerical black box functions as well. In this special case however, we have a different option: make sure that Plot sees the expression of the function. It will recognize HeavisideTheta as a function with a discontinuity, and it will plot the discontinuities as their precise location (not at a ...

2

Not sure I understand your question, but it seems like you just need to format your trig function calls in Mathematica syntax to accomplish what you're asking. A1 = {{1, 0, 0}, {Sin[phi], Cos[phi], 0}, {0, 0, 1}}; A2 = {{Sec[phi], -Tan[phi], 0}, {0, 1, 0}, {0, 0, 1}}; trans[x_, y_] := A1.A2.{x, y, 1}; trans[x, y] {x Sec[phi] - y Tan[phi], x Tan[phi] + y ...

2

Define your scalar product of the h polynomials: p[h[n_], h[m_]] := 16 Pi S Sum[Binomial[8 S + 2, k] (8 S + 1 - n - m - k), {k, 0, 8 S - n - m}] / (2^(8 S + 1) (n + m + 2) (n + m + 1) Binomial[8 S + 2, 8 S - n - m]) Add these properties: p[c_ pol1_h, pol2_] := c p[pol1, pol2] p[pol1_, c_ pol2_h] := c p[pol1, pol2] p[sum_Plus, pol_] := p[#, pol] & /@ ...

1

EDIT Using Sow and Reap for general function. Mush less efficient than ybeltukov: cnt[k_, n_] := Last@Reap[Sow[1, PrimeOmega@#] & /@ Range[n], k, Total@#2 &] Timing: cnt[3, 100000] // AbsoluteTiming yields: {2.263500, {25556}} Reassuringly same result... ORIGINALANSWER You could use Pick: f[u_] := Pick[Range[u], PrimeOmega /@ Range[u], ...

1

You can also perform this without "netsted functions" issue. For example: Count[IntegerPartitions[10][[All, 1]], #] & /@ Range[10] It could be even faster but we have to assume that you know the output of IntegerPartitions (explained on the bottom): Reverse @ Tally[IntegerPartitions[10][[All, 1]]][[All, 2]] Description IntegerPartitions[10][[All, ...

1

The Fourier series of the sawtooth is differentiable, being made up of sines. However, as ybeltukov pointed out in a comment I did not read until he made me aware of it, Fourier series of piecewise continuously differentiable functions tend to overshoot a jump discontinuities, something which is called Gibbs phenomenon. For that reason a Fourier series may ...

1

If I understand your question correctly, you just need: A[x_] = {{1,0,0},{Sin[x], Cos[x], 0},{0,0,1}} Also if you are just looking for the rotation matrix, you can use RotationTransform function

1

I think I can answer my question. Mathematically, it makes sense to tell Mma which variable is the one to integrate by parts, like LaplaceTransform or D. Taking this into account, I redefine parts like this parts[u_,v_,{x_,n_}]:= Sum[(-1)^m D[u,{x,m}] Nest[Integrate[#,x]&,v,m+1],{m,0,n-1}] + (-1)^n Integrate[D[u,{x,n}] ...

1

Let me expand the comment. If the list of replacement rules data is to be considered a global variable, you can access it from within your function and alter its value in this way data = {a->3, ab->2, ac->1, ad->0}; f1[{b_,c_}]:=Block[{tmp}, tmp = {b+1, c+1}; data = data /. Rule[a,_]:>Rule[a,tmp[[2]]] ] This will produce a new ...

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