New answers tagged

2

This can be done in 12.2 as follows. DiscreteAsymptotic[Sin[Pi*Sqrt[n^2 + n]]^2, n -> Infinity] 1


3

Clear["Global`*"] R = 25 (69634*^3); ri = 6 R; r0 = 7*^4 R; T = 4000; h = QuantityMagnitude[Quantity[1, "PlanckConstant"] // UnitConvert]; c = QuantityMagnitude[Quantity[1, "SpeedOfLight"] // UnitConvert]; k = QuantityMagnitude[Quantity[1, "BoltzmannConstant"] // UnitConvert]; F[v_?NumericQ] := 4 Pi h v^4/...


3

Computed with numerical method hardwaycoulomb[2, 1, 1, 1, 1]=1 (with some error). Let define pott = (Sin[t] Sin[tp])/(Sqrt[2] Sqrt[ 1 - Cos[t] Cos[tp] - Cos[p] Cos[pp] Sin[t] Sin[tp] - Sin[p] Sin[pp] Sin[t] Sin[tp]]); integ = Conjugate[SphericalHarmonicY[L, m1, t, p]] SphericalHarmonicY[ L, p1, t, p] pott Conjugate[ SphericalHarmonicY[...


1

final modification Numerical solution using Boole and the correct period: prob[a_?NumericQ, b_?NumericQ] := Block[{zw, T}, T = 2 Pi /GCD[a, 2 a , 3 b ]; NIntegrate[Boole[(Cos[a x] + 2 Cos[3 b x])(3+ 4 Cos[2 a x]) >= 0], {x, 0,T} ]/T] prob[10,100] (* 0.468571*) addendum Alternatively Reduce evaluates the subintervalls f>0in the range 0<x<T. ...


0

There are several ways of doing this. Here are two that come first into mind. expr = (1.0*10^-10)/(1.0*10^-11 + 1.0*10^-12*x); 1/Simplify[Denominator[expr]/Numerator[expr]] (* 1/(0.1 + 0.01 x) *) MapAt[Simplify[Divide[#, Numerator[expr]]] &, expr, {{1}, {2, 1}}] (* 1./(0.1 + 0.01 x) *) Have fun!


1

The best solution I've found is quite simple despite of the struggle in making everything works. t0 = 0; tfin = 300; TS1 = 0.2 // Rationalize; TS2 = 0.3 // Rationalize; TS3 = 0.6 // Rationalize; eqTime = {time'[t] == 1, time[0] == t0}; ac1 = {a[t] -> a[t] + 0.1, Hold@Sow@"a"}; ac2 = {a[t] -> a[t] + 1, Hold@Sow@"b"}; ac3 = {a[t] ->...


1

A combination of pattern matching and the function Distribute can help. exp = z[Δ] == (1 + g k^2 + h)/(Δ + g + (U/h)); exp /. {z[Δ] -> z[Δ/k], x__Plus :> Distribute[x/k]} (* z[Δ] == (1/k + h/k + g k)/(g/k + U/(h k) + Δ/k) *) TeXForm[exp /.{z[Δ] -> z[Δ/k], x__Plus :> Distribute[x/k]}] $z\left(\frac{\Delta }{k}\right)=\frac{g k+\frac{h}{k}+\frac{...


6

checkPi[n_] := ToExpression[Import[StringJoin["https://api.pi.delivery/v1/pi?start=", ToString@n, "&numberOfDigits=", ToString@IntegerLength@n]][[1, 2]]] == n; checkPi@36541622473 True checkPi /@ {1, 16470, 44899, 79873884, 711939213, 36541622473, 45677255610, 62644957128, 656430109694} {True, True, True, ...


2

@LouisB supplied the answer and this is just an extended comment illustrating how other models using that answer might be selected. First, rather than a linear model with a polynomial of order 1, consider a quadratic (2nd degree polynomial). arg = unwind[Arg /@ list]; abs = Abs /@ list; lm2 = LinearModelFit[Transpose[{arg, abs}], {x, x^2}, x]; ...


2

StringTrim and patterns combined with StartOfString or EndOfString, or RegularExpression equivalant patterns, can trim from the left or right of strings. For example, use StartOfString and strings, patterns or regular expressions to trim only from the left (i.e, the start) of a string. StringTrim["aaaXYZaaa", StartOfString~~"a"..] // ...


1

You can get what you want with f[x_] := (1 - Exp[-2 x^2])/(x Sin[x]) N[f[0.00001`110] - 2, 100] -1.666666666562777777782570105819928019179899684996459155594960567785431348232514315228566944038032233*10^-10 I added the extra 10 digits of precision to 0.00001 to allow for some round off error in the final result.


9

It will be easier to fit the data if it does not wind around the origin. So, let's unwind the spiral. Applying the Arg function to the data list gives ListLinePlot[Arg/@list] We see that arguments are decreasing, except where they jump up by $2\pi$. We want to unwind the arguments by removing the jumps. Here is a function that will unwind the arguments ...


1

The result of f[10^-5] is an exact number. On the contrary, the result of f[0.00001] is obtained using machine precision arithmetic. If you then say: N[f[0.00001] - 2, 100], The evaluation loop of MMA first evaluates the arguments of N, that is f[0.00001] and this uses machine precision. Afterwards N can not give you more accurate results than its input and ...


2

Try the following code fun = Sum[I^(-n) BesselJ[n, r] Exp[I n phi], {n, -k, k}]; pl = Position[fun, DifferenceRoot[_]]; fun1 = Table[{Subscript[f, i] @@ fun[[pl[[i, 1]], 0, 1, 1]] == fun[[pl[[i, 1]], 0, 1, 2]]}, {i, Length@pl}] /. {\[FormalY] -> y, \[FormalN] -> n}; ReplacePart[fun, Table[pl[[i]] -> Subscript[f, i], {i, Length@pl}]] // ...


3

Try this: https://reference.wolframcloud.com/language/ref/FunctionSingularities.html For instance: FunctionSingularities[Tan[x], x] or FunctionSingularities[ArcTan[x^y], {x, y}, Complexes]


3

v[s_, t_] := -g/s (Exp[-s t] + 1) g = 9.8; slist = {0.1, 0.2, 0.4, 0.8}; Plot[Evaluate[v[#, t] & /@ slist], {t, 0, 10}, PlotTheme -> {"BoldColors", "Frame", "Grid"}, FrameLabel -> {Automatic, v[t]}, FrameStyle -> Directive[14, Black], PlotLabels -> slist ]


1

It's slightly more complicated I think. You have to be able to solve for c1...c4 but also you need to show the injectivity and surjectivity of these maps. I will ignore the possibility of finite fields though it does seem that all this will hold outside of characteristic 2. polys = {c1, c2, c3, c4} - {a3 (a2 + a3) + a4, a3 + a1 (a2 + 2 a3), a1 + a1^2 + ...


1

list = {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1} /. 2 -> 0; A variation on ciao's approach for integer input with 0 as bin divider: ClearAll[binCounts1] binCounts1 = Differences @ Random`Private`PositionsOf[ArrayPad[#, {1, 1}], 0] - 1 &; binCounts1[list] {2, 3, 0, 1, 1} A much slower alternative using SequenceCases: ClearAll[binCounts2] binCounts2 = ...


2

One approach is to construct the values of the iterator explicitly. For example: Table[i, {i, Exp[Range[0, 1, 0.01]] - 1}] has lots of values near zero and progresively fewer at larger values. Of course, if you want a function $f$ of these, it's straightforward: Table[f[i], {i, Exp[Range[0, 1, 0.02]] - 1}] And of course, Do uses the same iterator structure ...


5

I do not believe the current answers correctly produce the result you appear to be after (which seems to be a "stars and bars" representation). This would be one way to do this: bincnts = (Join[{0}, PositionIndex[#][0], {Length[#] + 1}] // Rest[#] - 1 - Most[#] &) &; To illustrate the difference, I'll use the currently most upvoted ...


2

Here's one way: rules = CoefficientRules[P, {x, y}] newrules = MapAt[f, #, 2] & /@ rules FromCoefficientRules[newrules, {x, y}] Or, in general, CoefficientMap[f_, P_] := FromCoefficientRules[ MapAt[f, #, 2] & /@ CoefficientRules[P, Variables[P]], Variables[P]] CoefficientMap[f_, P_, vars_] := FromCoefficientRules[ MapAt[f, #, 2] & /@ ...


6

If we were to use 0 instead of 2 as the bin divider... list = {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1} /. 2 -> 0 (* {1, 1, 0, 1, 1, 1, 0, 0, 1, 0, 1} *) ... then we could write: Total /@ Split[list, # != 0 &] (* {2, 3, 0, 1, 1} *) Update Taking account of subsequent comments and the updated question... count[list_] := Total /@ Split[Append[list, 0], # != ...


4

It works if the data are given as a string instead of as a list: StringLength /@ StringSplit["11211122121", "2"] (* {2, 3, 0, 1, 1} *) The conversion to string, if required, can be done with StringJoin @@ ToString /@ {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1} (* "11211122121" *) To address @ciao's concern, add the All ...


3

What you wrote is almost correct. You just need to changef' := 1/g[x] to f'[x_] := 1/g[x]. Using L[x], you will obtain the desired result


2

Split[{1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1}, SameQ] /. {x : {1 ..} :> Length[x]} /. {x : {2 ..} :> Sequence @@ ConstantArray[0, Length[x] - 1]} Note: your example has no divider as the first or last element. If an initial or final sequence of 1s can be empty -- that is, if the first or last element can be a bin divider -- the answer changes


3

Not directly. {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1} //. {x___, 2, 2, y___} :> {x, 2, 3, 2, y} // SequenceSplit[#, {2}] & // # /. {3} :> 0 & // Map[Length]


1

Given your definitions eqns = z == x^4 + 1 && y == x^2 + x + 1; you can plot the resulting curve Show[Region[ImplicitRegion[Eliminate[eqns, x], {y, z}]], Axes -> True]


2

σ = 9; L[s_, d_] = (1/(σ*Sqrt[2*π]))* E^(-(1/2)*((s - (-50 - 11*Log[d]))/σ)^2); The probability distribution is dist[s_] = ProbabilityDistribution[L[s, d], {d, 0, Infinity}, Method -> "Normalize"]; r[s, d] is the PDF of the distribution r[s_, d_] = PDF[dist[s], d] Verifying the normalization, Integrate[r[s, d], {d, 0, Infinity}] (* ...


1

If the $d$ takes on values from 0 to $\infty$, then the normalizing constant is given by Integrate[L[s, d], {d, 0, ∞}] (* 1/11 E^(-(1019/242) - s/11) *) So you could define the following function which is non-negative and integrates to 1 for a pdf associated with $d$: r[s_, d_] := L[s, d]/(1/11 E^(-(1019/242) - s/11)) You should avoid using capital letters ...


1

As already been advised in the comments: Don't use N - it is reserved. Use E instead of e. e is just a parameter. There are 2 functions that can help you: ComplexPlot,ComplexPlot3D. You can read about them here. I will provide you an example: nf = 4; (*Final n*) f1[r_, \[Phi]_] := Sum[(BesselJ[n, r]*E^(I n \[Phi]))/I^n, {n, -nf, nf}]; (*Changing to ...


3

From the Functions Wolfram site we get EllipticTheta[2, z, q] == (q^(1/4) EllipticTheta[3, z - (Pi/2) τ, q])/ E^(I z) /; q == E^(I Pi τ) So define a new theta Th2 and test the identity with the code Th2[z_, tau_] := With[{q=E^(I Pi tau)}, E^(I Pi tau/4) EllipticTheta[3, z - (Pi/2) tau, q]/ E^(I z)]; test1[tau_] := With[{q=E^(I Pi tau)}, {Th2[0, 2tau]^...


2

sol = x /. Solve[36 Cos[(3 x)/4] Cos[(27 x)/20] (Cos[(3 x)/5] + 2 Cos[(21 x)/10]) == 0&& 0 < x < 4 Pi] Plot[36 Cos[(3 x)/4] Cos[(27 x)/20] (Cos[(3 x)/5] + 2 Cos[(21 x)/10]), {x, 0, 4 Pi}, Epilog -> {Red, Point[Transpose[{sol, ConstantArray[0, Length@sol]}]]}] If you desire only roots that are rational multiples of Pi, you can ...


0

My code is long and sometimes redundant. I'd like post it here to learn how to fix that. list1a = {1/x, -1 + x, -(x/(-2 + x)), "", -1 + 1/x, "", -1 + 2 x}; list1b = Join[{ Style["list1", 16, Bold]}, list1a] (* tuples*) list2a = {{{a, b}}, {{c, d}}, {{a, c}, {b, d}}, {{e, f}, {g, h}}, {{d, t}}}; list2b = Join[{Style["...


4

Lot's of ways to achieve this. A few follow: list1 = {"list1", 1/x, -1 + x, -(x/(-2 + x)), -1 + 1/x, -1 + 2 x}; list2 = {"list2", {{a, b}}, {{c, d}}, {{a, c}, {b, d}}, {{e, f}, {g, h}}, {{k, t}}}; list3 = {"No.", 1, 2, 3, 4, 5}; Grid[Transpose[{list3, list2, list1}], Frame -> All] This gets a bit closer: list1 = {"...


11

Permute exists for reordering lists. Permute[list, Cycles[{{1, 4}, {2, 5}, {3, 6}}]] This swaps entries $1 \leftrightarrow 4$, $2 \leftrightarrow 5$ and $3 \leftrightarrow 6$. The necessary permutation can be found using FindPermutation: FindPermutation[Range@9, {4, 5, 6, 1, 2, 3, 7, 8, 9}] Cycles[{{1, 4}, {2, 5}, {3, 6}}]


6

Id suggest using TakeList TakeList[ist, {{4, 6}, 3, All}] TakeList[ist, {{4, 6}, {1, 3}, {1, 3}}] The indices need to be relative to those elements that are not yet taken. If you have absolute indices given: ist = Range[20]; parts = {{5, 6}, {9, 13}, {1, 4}, {19, 20}, {14, 18}}; Catenate[ist[[# ;; #2]] & @@@ parts]


7

At least shorter: Flatten@Partition[list, 3][[{2, 1, 3}]]


4

I think one way to do this is: Select[mytup, !(#[[8]] == -1 && #[[9]] == 1 && MemberQ[mytup, # * {1, -1, 1, 1, -1, 1, 1, -1, -1}]) &] This keeps exactly the ones that fail the criterion, i.e. deletes the ones that do satisfy having their 8th part be -1, their 9th part be 1, and such that the list contains some member equal ...


3

The U.S. National Imagery and Mapping Agency (NIMA) (formerly the Defense Mapping Agency) adopted a special grid for military use throughout the world called the Universal Transverse Mercator (UTM) grid. In this grid, the world is divided into 60 north-south zones, each covering a strip 6° wide in longitude. These zones are numbered consecutively beginning ...


4

I believe the relation you wrote is only valid for $n>2$. For $n=0,1,2$ you have to use the identities of eq.(2.31) in [1705.02909], \begin{equation} \begin{aligned} t_{0,n_1,n_2\dots} &= Nt_{n_1,n_2},\\ t_{1,n_1,n_2\dots} &= 0,\\ t_{2,n_1,n_2\dots} &= \frac{N^2-1+n_1+n_2+\dots}{2}t_{n_1,n_2,\dots}. \end{aligned} \end{equation} The code below ...


Top 50 recent answers are included