Hot answers tagged

16

I would approach this from the fact that both are forms of multiplication, but one has a negative exponent. So RandomReal[{1, 20}]^RandomChoice[{1, -1}] will randomly be either 1/x or x, where x is a random number between 1 and 20.


12

Although the question singles out the square, it is made clear that the actual applications includes other polygonal shapes as well. This means that it's impossible to give a general answer based on the assumption of separability. The square is separable in Cartesian coordinates, but the pentagon (e.g.) is not. This is why I'm focusing this answer on the ...


8

This is not a bug. It is an expected result of numerical roundoff error and the somewhat unusual way Mathematica computes division. What is roundoff error? Floating point numbers have a finite precision. With almost any arithmetic operation performed, the result is not exact: digits beyond about the 16th get discarded. What's special about how ...


7

I urge you not to use the answer you have been given, because it adds spurious precision (hence incorrect digits) to the result, which will be more obvious if you attempt to use a higher precision. The result you have is already precise (albeit not necessarily accurate) up to 15 digits; it's just that the front end won't display all of the digits by ...


7

You can use RotationTransform. With[{rot = funs[[3]] /. Inner[Rule, {x, y}, RotationTransform[π/2][{x, y}], List]}, ContourPlot[rot, {x, -.5, .5}, {y, -.5, .5}] ] Hope this helps. Also with Manipulate Manipulate[ With[{rot = funs[[3]] /. Inner[Rule, {x, y}, RotationTransform[θ][{x, y}], List]}, Quiet@ContourPlot[rot, {x, -.5, .5}, {y, -.5, ...


6

This looks like a numerical precision issue. Various approaches that precisely address this, all yield the same, correct solution: Scaling of the x values: data = {{0, 20}, {20, 10}, {40, 5}, {60, 2.5}, {80, 1.25}}; {xmin, xmax} = MinMax[data[[All,1]]]; data2 = {Rescale[data[[All, 1]]], data[[All, 2]]} // Transpose; fit1 = FindFit[data2, a*Exp[b*x], {a, ...


6

In the comments I supposed that the reason why the algorithm stops is obtaining zero derivative with respect to b at the point {a, b} = {0., 1.} returned as the minimum. Let us check this statement by perturbing the actual Jacobian a little bit in order to make all the derivatives non-zero. Proceeding from the code in the question, we find the Jacobian and ...


5

rotation = {x, y}.{{Cos[t], Sin[t]}, {-Sin[t], Cos[t]}}; f[t_] = funs[[3]] /. {x -> rotation[[1]], y -> rotation[[2]]}; Manipulate[ ContourPlot[f[t], {x, -.3, .3}, {y, -.3, .3}], {t, -\[Pi], \[Pi]}]


5

I am one of the many that does not consider this a bug as it is shared by probably the majority of statistical packages. (But there certainly is room for improvement in terms of warnings that could be given.) Iterative procedures work great if the starting values are close enough to the final values. When one doesn't know the final result this requirement ...


5

Depending on the distribution desired, you could use the log-normal (or a similar transformation of whatever distribution has a mean of 0). It is transformed distribution such that a value -y < 0 of the underlying distribution is transformed to 1/x iff the value y > 0 is transformed to x (i.e., Exp[-y] == 1/x where x = Exp[y]). The "underlying" ...


4

Assuming that this is required only for formatting purposes, as it was in this seemingly identical question (I cannot decide which of these should be closed as the duplicate of the other, and would be grateful if someone could help me do so), then I would like to provide another approach in addition to what has been proposed so far. It seems to me that the ...


4

The formula for spectral norm you are using is meant to be the formal mathematical definition of the quantity. However this is restrictive for practical use as symbolic norm calculation on high dimensions are very cumbersome. The formulation you might be looking for is the following. Here $\mu_{2}$ is the logarithmic two norm. $$\mu_{2}(A) := ...


4

So you already found a way to do this with NMinimize, and we can apply that to this problem, Y1[a1_, b1_, c1_, d1_, e1_, f1_] := ({{a1, b1, c1}, {b1, d1, e1}, {c1, e1, f1}}); Y2[a2_, b2_, c2_, d2_, e2_, f2_] := ({{a2, b2, c2}, {b2, d2, e2}, {c2, e2, f2}}); MA = r*(kd*Y1[a1, b1, c1, d1, e1, f1] + s*Y2[a2, b2, c2, d2, e2, f2]); MB = r*(kd*Y1[a1, ...


4

One way: RandomChoice[{Times[x, #] &, Divide[x, #] &}][RandomReal[{1, 20}]] To repeat, use a Table or Do expression, etc.


4

You can eliminate the two 1. but, as Pickett already commented, you cannot easily change the complex number 0. + 0.57735 I to 0.57735 I (res = Chop[mymatrix] /. Times[a_, b_] /; Round[a, 10^-12] == 1. :> b) // MatrixForm What you could do now (for display purposes) is res /. Complex[a_, b_] /; a < 10^-12 :> HoldForm[b I] // MatrixForm and ...


3

If you need result at some sensible time frame vs quality... f[x_, y_] := Piecewise[{{1, Sqrt[x^2 + y^2] < 1}}] nconv[t_, z_] := NIntegrate[f[x, y] f[x - t, y - z], {x, -Infinity, Infinity}, {y, -Infinity, Infinity}] data = ParallelTable[nconv[t, z], {t, -3, 3, .2}, {z, -3, 3, .2}]; // AbsoluteTiming {57.205376`, Null} ListPlot3D[data, ...


3

Indeed, NDSolve cannot solve this equation as written. However, it is easy enough to eliminate y from the system. {x'[t] == y[t] + x[t] y[t] + z[t], z'[t] == 2*y[t]} /. y[t] -> 1 + z[t] - 2 x[t] and then solve and plot s1 = NDSolve[{Derivative[1][x][t] == 1 - 2 x[t] + 2 z[t] + x[t] (1 - 2 x[t] + z[t]), Derivative[1][z][t] == 2 (1 - 2 x[t] + ...


3

You can use FindRoot! First, take a look at the contour plot of $f$: ContourPlot[f[h, b], {h, 1, 6}, {b, 0, 6}, PlotPoints -> 100, Contours -> {0.1, 0.3, 0.5, 0.7, 0.9}, ContourLabels -> True, ContourShading -> None, ContourStyle -> GrayLevel@0.7, FrameLabel -> {h, b}] Note that there is a saddle point at $(h, b) = (1.75, ...


3

ParametricNDSolve will return a numerical ODE solution with any number of free parameters. This parametric solution can then be fed into NonLinearModelFit (or whatever home-brew chi-squared algorithm you want to cook up) to find the best-fit values for the parameters. As an example, suppose we want have the ODE $y''(x) = - y(x)$, with initial conditions ...


3

Interesting equation. It seems to be necessary to use the asymptotic solution as the boundary at $x=x_0$ if you want to solve the equation correctly. Thanks to this answer, we can easily get the series solution at $x=0$ with seriesDSolve: eq1 = 1/5 (y[x] - 2 x y'[x]) == D[(x y'[x])/y[x] + x y[x]^3 D[D[x y'[x], x]/x, x], x]/x; bc1 = y[x] - 2 x y'[x] == 0; ...


3

Here is a trashy way to do it: Unprotect[Complex] Format[Complex[0.`, x_]] := HoldForm[x I] Protect[Complex] Now mymatrix // Chop // MatrixForm returns:


2

LinearSolve[(N@SparseArray)@foo, bar]


2

You can accomplish something very similar to your pseudo-code by defining a function: rand := RandomChoice[{Times, Divide}] Now every time you call the rand function, it either multiplies or divides its two arguments. For example, rand[3, 4] returns 12 half the time and 3/4 the other half. Now you can replace the "4" with a randomly chosen number and ...


2

You can just multiply the random numbers by a windowing function that does go to zero in the way you want. One choice is a super-Gaussian, it's like a smooth version of a square windowing function (with n=6 below, but you can choose other values Plot[Exp[-(x/120)^6], {x, -210, 210}, PlotRange -> {0, 1}] Here is the initial data, bounds = 200; width ...


2

Some of the definitions in the original question were problematic. I edited the question to have more consistent code. In order to plot the function numerical values are needed, so using Integrate is not necessary. We can use NIntegrate instead. The plot is produced within 30 seconds on my laptop with Mathematica 10.3.1. Here is the function redefined: ...


2

As @bbgodfrey commented, if the integrals in the equation in the OP's FindRoot command can be evaluated before passing the equation to FindRoot, one can save a lot of time. It seems there is still more to be done. I found FindRoot struggles to find an accurate root in some areas of the domain of the equation. It turns out one can use Solve to solve the ...


2

Automatically looking for proper $y(0)$ and $y''(0)$ isn't easy, at least I can't think out a solution, still, I don't think you need such fascinating technique to solve the new equation, you just need to slightly modify the code for plotting to filter out those improper $(a,b)$: Quiet@ContourPlot[ If[y["Domain"][[1, -1]] < xMax, 1, #] == 0 & /@ ...


1

In a simplified 1D version my idea may look as follows. Here are two lists of the amplitudes, that I limited by 10 terms: lst1 = RandomReal[{-1, 1}, 10]; lst2 = RandomReal[{-1, 1}, 10]; Here are the arbitrary functions defined as the Fourier-polynomials with the above amplitudes: y1[x_] := Sum[lst1[[i]]*Sin[x*i], {i, 1, Length[lst1]}] y2[x_] := ...


1

bounds = 200; f[{x_, y_}] := CDF[GammaDistribution[4, 2], 15 Rescale[ Min@Outer[Abs[Subtract@##] &, {x, y}, {bounds, -bounds}], {0, bounds}, {0, 10}]]/2 // N func = Interpolation@Flatten[Table[{{x, y}, RandomReal[{-#, +#}] &@ f[{x, y}]}, {x, -bounds, +bounds}, {y, -bounds, +bounds}], 1]; DensityPlot[func[x, y], ...


1

I don't know what value of k you are using, so in the code below I set it to 0.1. Also, fixed the RK4 code so that it works, but now it's pretty slow. (* set k to your value for k *) k = .1; f[y_, mu_] := -1/(1 + Exp[(Abs[y] - mu)/k]) + 1; mu[n_] := mu[n] = 0.5 + 0.1 Sign[y[n] - y[n - 1]]; x[0] = 0.0; y[0] = 0; y[1] = 0.1; x[n] = 2; h = .01; x[n_] := x[n] ...



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