Tag Info

Hot answers tagged

32

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


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


19

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


18

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


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


18

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


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


14

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


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


13

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}


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


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

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]


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

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


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


10

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


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

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


10

I would check out first Michael Trott blog: On the Importance of Being Edgy—Electrostatic and Magnetostatic Problems with Sharp Edges. From that you can easily construct: \[Phi]LineSegment[{x_, y_, z_}] = WolframAlpha[ "electric potential of a charged line segment", {{"Result", 1}, "Input"}][[1]] /. {Subscript[\[Epsilon], 0] -> 1/(4 Pi), l ...


10

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


9

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


9

Assuming that the lengths of the lists are integer multiples of each other, you could do this: x = RandomInteger[{0, 100}, 100]; y = RandomInteger[{0, 100}, 200]; Mean /@ Partition[y, Length[y]/Length[x]] (* ==> {37/2, 79, 23, 58, 111/2, 59, 143/2, 45/2, 51, 123/2, 57, \ 76, 43, 111/2, 93/2, 33, 97/2, 37/2, 51, 151/2, 43, 7/2, 191/2, \ 123/2, 44, 49, ...


9

I'm going to assume that "everything" includes some simple ContourPlot and StreamPlot attempts, but that you are getting mired in the style details of your plots (missing streamlines, streamlines not where you want them, colors, etc.) To draw the charge distributions, we can use Graphics. gP1 = Graphics[{PointSize[Large], Point[{14, 10}]}]; gP2 = ...


9

You are treating $A$ and $B$ as column vectors and combining them column to column, but if you just bracket the two vectors, you are combining them row to row. A final Transpose will do the trick. A = {a, b}; B = {c, d}; NotYourResult = {A,B} Result = Transpose[{A, B}] where NotYourResult is assigned {{a,b},{c,d}} or $\left[ {\begin{array}{cc} a & ...


9

This uses some version 10 functions: Getting the data (takes time as I could have set this up better): dat = Table[{i, j, WeatherData[{j, i}, #] & /@ {"WindSpeed", "WindDirection"}}, {i, 113, 153, 4}, {j, -43, -11, 4}]; Processing: data = Cases[{{#1, #2}, -QuantityMagnitude[#3[[1]]] {1/Cos[#2 Degree], 1} Through[{Sin, ...


9

The following is far from perfect, just a kickstart: image = ColorConvert[Rasterize[8, ImageSize -> 40], "Grayscale"] {dx, dy} = Table[ImageAdjust@ GaussianFilter[ image, {6, 3}, δ], {δ, {{1, 0}, {0, 1}}}]; data = Reverse /@ Transpose[2 ImageData /@ {dx, dy} - 1, {3, 2, 1}]; p = ListStreamPlot[data, StreamPoints -> {400, .2, 10}, Frame -> ...


8

Define the inner product modulo $2$: orthogonalize[a_] := Mod[Orthogonalize[a, Mod[#1.#2, 2] &], 2] Example: (m = Union[orthogonalize[RandomInteger[{0, 1}, {500, 64}]] ]) // ArrayPlot Check orthogonality: Mod[m . Transpose[m], 2] // ArrayPlot



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