Hot answers tagged

36

The first step is to rasterize the points, so let's just start there as an example: n = 512; g = Image[Map[Boole[# > 0.001] &, RandomReal[{0, 1}, {n, n}], {2}]] The trick is to exploit the distance image. Almost all the work is done here (and it's fast): i = DistanceTransform[g] // ImageAdjust // ImageData; We need a little more precomputation ...


31

Edit: I added more explanations below, because this visualization method is quite different from conventional vector plots For just this purpose I had at some point invented the following visualization technique. I'll reproduce your definition first. It defines a complex vector field on the surface of a unit sphere. Clear[ϵ];(*Polarization vector*)ϵ[λ_] = ...


21

I recommend using Transpose twice since it is more efficient than other approaches. Moreover Plus has the Listable attribute, thus one need not map Plus over a list (vector). Transpose[v1 + Transpose[v2]] {{a + d, b + e, c + f}, {a + g, b + h, c + i}, {a + j, b + k, c + l}} Having said that remember that one can rewrite it very concisely in the ...


20

If you want a random vector just because you need some arbitrary vector and you don't really care what it is, then Mr.Wizard's method of picking three random coordinates in [-1,1] will work. But if you care about the statistical properties of your vector, and in particular if you want it drawn from a uniform distribution over the surface of the sphere, then ...


20

Maybe you can transform this into an easier problem: If you were instead looking for lines that are at any point perpendicular to your vector field: (that's easy, it's just a coordinate transformation) and if your (transformed) vector field were the gradient of a scalar field (yes, big if), then this would be really easy: These lines are simply the level ...


19

I know think of at least one way of doing it slowly and in a bitmap approach: img[p_, r_] := Module[{f, closest, color, colors, n, t}, n = 250; colors = List @@@ {Red, Green, Blue, Yellow, Orange, Pink, RGBColor[0, 0, 0], Cyan, Magenta, Brown, Purple}; color[i_] := Module[{c}, c = colors[[1 + Mod[i, Length@colors]]]; If[i == 0, {1, ...


19

Here are two suggestions for the function f[z_] := 1/z; First, instead of defining a region to omit from your plot, you should base the omission criterion on the length of the vectors (so that you don't have to adjust the criterion manually when switching to a function with different pole locations). That can be achieved like this: With[{maximumModulus = ...


19

When n is large and x is known, using a PackedArray may be a good option. ar3=ConstantArray[0,3n]; ar3[[3;;;;3]]=Range[x, n x, x]; ar3 To see that the result is a PackedArray, we see that << Developer`; PackedArrayQ[ar] True Whereas for Kuba's last array we would have False (even if x has a value). Note that ConstantArray also produces a ...


18

There are many ways, for example: n = 5; l = SparseArray[i_?(Divisible[#, 3] &) -> i/3 x, {3n}, 0] SparseArray[<5>,{15}] List @@ l {0, 0, x, 0, 0, 2 x, 0, 0, 3 x, 0, 0, 4 x, 0, 0, 5 x} (*earlier Array[# x &, n], `Range thanks to Simon Woods's, tom's and Mr. Wizard's comment*)  Riffle[Range[x, n x, x], ...


16

Here is a very simple way to do it: Table[1/i! D[M, {a, i}] /. a -> 0, {i, 0, 3}] (* ==> {{{15, 0}, {0, 2}}, {{0, 1}, {1, 0}}, {{1, 5}, {-5, 0}}, {{0, 0}, {0, 0}}} *) This works even if the entries are not polynomials. If they are, you can replace the arbitrary maximum 3 in the Table index by the degree of the polynomial: Max[Exponent[M, a]] ...


16

You can't define an unassigned symbolic variable throught itself. You are trying to do something like that: x = F[x] This is not right for symbolic computations, because x evaluates to itself as a pure symbolic value. Your code in FullFrom is: Equal[v, List[Subscript[v, 1], Subscript[v, 2], Subscript[v, 3]]] So, you get the recursion. Try different ...


15

David's answer has given the methods for producing random points that are uniformly distributed over the surface of the sphere. Of course, there are other probability distributions on the sphere that are of interest, as well as a number of methods for generating them. For instance, here is how to generate a random unit vector which follows the von ...


15

Following this question you can define: invmollweide[{x_, y_}] := With[{theta = ArcSin[y]}, {Pi (x)/(2 Cos[theta]), ArcSin[(2 theta + Sin[2 theta])/Pi]}]; fc[phi_] := Block[{theta}, If[Abs[phi] == Pi/2, phi, theta /. FindRoot[2 theta + Sin[2 theta] == Pi Sin[phi], {theta, phi}]]]; cart[{lambda_, phi_}] := With[{theta = fc[phi]}, {2/Pi*lambda ...


14

You can switch off the 1/0 messages with Off[Power::infy] Now 1/0 only returns ComplexInfinity. If you want to intercept that (your "prevent the divide-by-zero operation from happening in the first place" seems to imply that) you'd have to redefine Power[0,-1]: Unprotect[Power] Power[0, -1] = ...; Protect[Power] with '...' a definition of your choice. ...


14

Assuming that we have three-dimensional real vectors : $Assumptions = (u | v | w) ∈ Vectors[3, Reals]; we can use e.g. various tensor functions (new in ver. 9) e.g. TensorReduce to reduce (simplify) a tensor expression, e.g. TensorReduce[ v.v + w.w - (v + w).(v + w) ] TensorReduce[u \[Cross] (v \[Cross] w) ] -2 v.w -w u.v + v u.w We can perform ...


13

It's already built-in. It's called Cross. Cross[{1, 2}] Output is {-2, 1}


13

Accumulate@Array[b, {3}] (* {b[1], b[1] + b[2], b[1] + b[2] + b[3]} *) therefore: {a, b} = Transpose[list]; Transpose[{a, Accumulate[b]}] Also this will do the job: Rest@FoldList[{#2[[1]], #1[[2]] + #2[[2]]} &, {0, 0}, list] or even easier list[[All,2]]=Accumulate@list[[All,2]]; list


12

You should make use of Show and appropriate options e.g. we added PlotRange, AspectRatio etc. : Show[{ Plot[x^2, {x, -3, 3}, PlotRange -> 3, PlotStyle -> {Thick, Darker @ Green}], VectorPlot[{-y, x}, {x, -3, 3}, {y, -3, 3}]}, AspectRatio -> 1]


12

You could remove the zero from the denominator, and the corresponding entry from the numerator: a = {1, 2, 3, 4}; b = {5, 6, 0, 8}; Pick[a, Positive[b]]/Pick[b, Positive[b]] (* ==> {1/5, 1/3, 1/2} *)


12

Just for fun: Animate[Show[ ParametricPlot3D[r[t], {t, 0, u}, PlotRange -> {{-10, 25}, {-10, 10}, {-10, 15}}], Graphics3D@Sphere[r[u], 1]], {u, 0, 10 Pi}] I'm bored: Animate[Show[ ParametricPlot3D[r[t], {t, 1/100, u}, PlotRange -> {{-10, 25}, {-12, 10}, {-10, 15}}], Graphics3D[Table[{Opacity[1 - h/u], Sphere[r[u - h], 1]}, {h, 0, u - ...


12

To achieve what you need requires to distribute the sum over v2: (v1 + # &) /@ v2 which is a short form of: Map[ v1 + # &, v2 ]


11

You could also use something like OverVector, since OverVector[v] = {Subscript[v,1],Subscript[v,2],Subscript[v,3]} isn't recursive, and so won't cause problems. This takes a bit more effort to input Type Ctrl+& and then Esc vec Esc to enter directly but if you're interested in the typeset forms it might be worth it.


11

On this wikipedia page you find a collection of Tensor software and Mathematica has the biggest section. The package Ricci, which username acl pointed out in his answer is there, and I personally have used xAct. It looks like this And yes, as you suggest in your question, for smaller computation in specific dimensions you can also work in components ...


11

In Memory: Table is handy. v[x_, n_] := Flatten@Table[{0, 0, x i}, {i,n}] v[x,5] {0, 0, x, 0, 0, 2 x, 0, 0, 3 x, 0, 0, 4 x, 0, 0, 5 x} Or {0, 0, x #} & /@ Range@5 // Flatten Minimal Memory Here is an interesting approach if you want to access very large arrays without the memory overhead, create a function to return elements from an ...


11

NB I think there's a problem with this code, please see this answer by ubpdqn for more information. I'll update these snippets when I get the chance. Yours is a question with many possible interpretations. I've chosen the interpretation that was most fun for me to play with, so... ang = 20; (* divide the world into chunks of this size *) pts = ...


11

The definition of the scalar product in your question assumes that all your kets are orthogonal unit vectors. In that case, the most natural approach would be to use the built-in Bra and Ket as follows: Ket /: Dot[Bra[x__], Ket[y__]] := Times @@ MapThread[KroneckerDelta, {{x}, {y}}] BraKet[x_, y_] := Bra[x].Ket[y] Bra[2, 4].Ket[2, 4] (* ==> 1 *) ...


10

Here's one quick way for polynomial matrices: polyMat = {{15 + a^2, a + 5 a^2}, {a - 5 a^2, 2}}; Transpose[PadRight[CoefficientList[polyMat, a]], {2, 3, 1}] {{{15, 0}, {0, 2}}, {{0, 1}, {1, 0}}, {{1, 5}, {-5, 0}}} Alternatively (as Jens hints), you can do Flatten[PadRight[CoefficientList[polyMat, a]], {3}]. You can check that the matrix polynomial is ...


10

Solution You could use Graphics, Arrow and s which is a scaling factor and write arrows = {{{0, 0}, {1, 1}}, {{1, 0}, {1, 0}}, {{2, 0}, {0, 1}}, {{0, 1}, {1, -1}}, {{1, 1}, {1, 1}}, {{2, 1}, {-1, 1}}, {{0, 2}, {0, 1}}, {{1, 2}, {-1, 0}}, {{2, 2}, {0, -1}}}; s = 0.3; Graphics[{Arrow[{#1, #1 + s*Normalize[#2]}] & @@@ arrows, Red, ...


10

Here is a way to do all the things you asked for automatically, independently of Mathematica version. The approach relies on a special symbol to identify when we're dealing with a vector: Instead of using things like x, y etc. for vectors, the convention now is that vectors are written as vec[x], vec[y], etc. You could also define the wrapper OverVector[x] ...


10

A new solution I realized that comparing each and every value in the sections might be inefficient, especially in cases where the sections are long. Instead we need only the relative ordering of these elements from which we can compute the number of Less pairs. Here is my solution: Edit: Ray Koopman provided a greatly improved counting method (applied to ...



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