Hot answers tagged

9

How about this furious[a_, b_] := Module[{a1, a2, a3, b1, b2, b3, c}, {a1, a2, a3} = Transpose[a, {2, 3, 4, 1}]; {b1, b2, b3} = Transpose[b, {2, 3, 4, 1}]; c = {-a3 b2 + a2 b3, a3 b1 - a1 b3, -a2 b1 + a1 b2}; Transpose[c, {4, 1, 2, 3}]] Timing results (from march's answer) for version 10.4.1 list1 = RandomReal[{-1, 1}, {32, 32, 32, 3}]; list2 = ...


7

Interestingly enough, MapThreading Cross works but is much slower: Using sample lists: list1 = Array[c, {20, 20, 20, 3}]; list2 = Array[d, {20, 20, 20, 3}]; We can perform this operation in the following two ways, using MapThread: listCrossMarch1[list1_, list2_] := MapThread[Cross, {list1, list2}, 3] listCrossMarch2[list1_, list2_] := MapThread[{#1[[2]] ...


6

yourlist = {a, b, c}; mat = ReplacePart[Outer[Times, #, #]&@Prepend[yourlist, 1], {1, 1} -> state] Change yourlist to the list of your interest. Or, taking @mikado 's idea of symbolically diagonalizing: matfunc[1, 1] = state; matfunc[1, a_Integer] := yourlist[[a - 1]]; matfunc[a_Integer, 1] := yourlist[[a - 1]]; matfunc[a_Integer, b_Integer] := ...


5

One thing you might want to do is write the vector $\vec{a}$ as some magnitude $\theta$ times a unit vector {a1, a2, a3}. Then calculate $\exp(i \theta \,a\cdot\sigma)$. This will allow you to get rid of those factors of $\sqrt{a_1^2+a_2^2+a_3^2}$, which are just some $\theta$ anyway. Here it is in Mathematica:a = \[Theta] {a1, a2, a3}; b = a.Array[...


5

I believe that the following code selects the columns of the matrix that provides an approximate "Interpolative Decomposition". This means that all the other columns can be written as linear combinations of the selected columns with minimal coefficients. There are some interesting results (I believe) on how small these coefficients need be (never greater ...


5

This is very short: vec = {a[1], a[2], a[1] + 2 a[2] - a[3]}; Transpose[D[vec, {Array[a, 3]}]] (* ==> {{1, 0, 1}, {0, 1, 2}, {0, 0, -1}} *) It gets the basis from the columns of the Jacobian for the linear relation in vec.


5

CoefficientArrays[] does nicely for this: CoefficientArrays[{a[1], a[2], a[1] + 2 a[2] - a[3]}, Array[a, 3]] // Normal // Last // Transpose {{1, 0, 1}, {0, 1, 2}, {0, 0, -1}}


3

With Times: avec = Array[a, 4]; m = Outer[Times, avec, avec] /. {a[1] -> 1}; m[[1, 1]] = s; MatrixForm[m] Eigenvalues[m] Here a[2] is your a, a[3] is your b, etc. Change the 4 to 900 if you wish. There are two nonzero eigenvalues.


3

Try something like this: Map[Coefficient[{a[1], a[2], a[1] + 2 a[2] - a[3]}, #] &, Table[a[i], {i, 3}]] (*{{1, 0, 1}, {0, 1, 2}, {0, 0, -1}}*)


3

Specify Eigensystem[h, 2, Method -> "Direct"] for both cases. That sparse array may go to a different solver (iterative) than the dense method. You can find more options in the documentation of Eigensystem under the options section.


3

Solve is one of the functions that returns a list of rules and you need to use the /. Replace All command. Read: http://support.wolfram.com/kb/12505 m = {{1, 1, 1}, {1, 2, 3}, {1, 4, 9}}; b = {1, 2, 3}; abc = LinearSolve[m, b] f = Dot[abc, {x, y, z}] sol = Solve[f == 0, z] Plot3D[z /. sol, {x, 0, 15}, {y, 0, 15}] And as J.M. mentioned f= Dot [abc, {x, y,...


3

To verify that the rotations happen the way they're supposed to according to the documentation for EulerMatrix, you could use the following Manipulate: Clear[arrowAxes]; arrowAxes[arrowLength_: 1] := Map[{Apply[RGBColor, #], Arrow[Tube[{-#, #}]]} &, arrowLength IdentityMatrix[3]] Manipulate[ Graphics3D[{GeometricTransformation[arrowAxes[.7], ...


3

For the first part, you can use MatrixExp. Since you are interested in trigonometric form, I would suggest using polar coordinates from the beginning. p0 = PauliMatrix[0]; p1 = PauliMatrix[1]; p2 = PauliMatrix[2]; p3 = PauliMatrix[3]; a1 = a Sin[q1] Cos[q2]; a2 = a Sin[q1] Sin[q2]; a3 = a Cos[q1]; m = a1 p1 + a2 p2 + a3 p3; m1 = MatrixExp[I m] // ...


3

Here is a way to do it: dim = 5; s = SparseArray[{{i_, i_} -> -2., {i_, j_} /; Abs[i - j] == 1 -> 1.}, {dim, dim}, 0.]; s[[1, All]] = s[[-1, All]] = 0.; s[[1, 1]] = s[[-1, -1]] = 1.; f = ConstantArray[0., {dim}]; f[[1]] = 0.; f[[-1]] = 1.; LinearSolve[s, f] {0.`, 0.25`, 0.5`, 0.75`, 1.`} Now, we can use: res = SparseArray`SparseMatrixILU[s] ...


3

$Version (* "10.4.1 for Mac OS X x86 (64-bit) (April 11, 2016)" *) Let m = <pastebin monster>. ns1 = NullSpace[m]; ns2 = NullSpace[m, Method -> "OneStepRowReduction"]; diff = ns1 - ns2; RootReduce[diff] (* {{0, 0, 0, 0, 0, 0, 0, 0}} *) So they're equivalent in V10.4.1. Update: Checking correctness After many minutes, this returns ...


2

You can directly use the function pauliReduce that I defined in this answer: a = {a1, a2, a3} (* ==> {a1, a2, a3} *) a.{σ[1], σ[2], σ[3]} (* ==> a1 σ[1] + a2 σ[2] + a3 σ[3] *) pauliReduce[ MatrixExp[I a.{σ[1], σ[2], σ[3]}]] $$\frac{1} {\sqrt{\text{a1}^2+\text{a2}^2+\text{a3}^2}}\left(\hat{1} \sqrt{\text{a1}^2+\text{a2}^2+\text{a3}^2} \cos ...


1

The matrix desired is at most rank two and can be easily expressed as the product of a matrix and its transpose. I will number the elements for convenience and assume that state > 1 (otherwise we have imaginary elements, which would require further thought). n = 3; v1 = Prepend[Array[a, n], 1]; v2 = Prepend[Array[0 &, n], Sqrt[state - 1]]; M1 = ...


1

You might want to consider giving an appropriate second argument (inner product function) to Orthogonalize. For example, In[66]:= vs2 = Orthogonalize[{x1, x2}, Dot[##]*Norm[#] &, Method -> "GramSchmidt"] Out[66]= {{1/2^(3/4), 1/2^(3/4), 0}, {-(1/3^(3/4)), 1/3^(3/4), 1/3^(3/4)}} In[67]:= Outer[Dot, vs2, vs2, 1] Out[67]= {{1/Sqrt[2], 0}, {0, 1/Sqrt[...


1

The answer depends on how you characterise the matrix. Let say you can define it in terms of sum of absolute values of the element. norm1[m_List] := Total@Flatten@Abs[m] Or you can define it as Norm of diagonal elements norm2[m_List] := Norm@Diagonal[m] Given a matrix m m = RandomReal[{-5, 5}, {3, 3}] {{-2.72364, 2.26668, 4.07867}, {-1.8835, 0....


1

We can put a wrapper q around the numeric values in our matrices. multcount = 0; addcount = 0; q[a_] q[b_] ^:= (multcount++; q[a b]) q[a_] + q[b_] ^:= (addcount++; q[a + b]) a_ q[b_] ^:= (multcount++; q[a b]) Defining A = RandomReal[9, {10, 10}]; qA = Map[q, A, {2}]; We can evaluate adjqA = Transpose[Table[Cofactor[qA, {i, j}], {i, 1, 10}, {j, 1, 10}]]...



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