Hot answers tagged

14

Since $(\vec{e},\vec{q},\vec{r})$ is an orthonormal triad, and assuming it is right-handed, we should use the identities $\vec{e}=\vec{q}\times\vec{r}\,$; $\hspace{5mm}\vec{e}\cdot(\vec{q}\times\vec{r})=1$, etc. In particular we have that ve = Table[Indexed[e, n], {n, 3}]; vq = Table[Indexed[q, n], {n, 3}]; vr = Table[Indexed[r, n], {n, 3}]; ve.Cross[vr, ...


12

matrix = {{1, -1, 1, 1, -1}, {-1, -1, -1, 1, 1}, {1, 1, 1, -1, 1}, {-1, 1, -1, 1, -1}, {1, 1, 1, -1, -1}}; SeedRandom[23]; Grid[matrix /. {-1 :> OrangeScribble[], 1 :> DarkGreenScribble[]}, Dividers -> All] Update A problem: If I change the number of raws and columns, then the size of the shape goes very big. I wish to change my matrix to ...


6

As @AntonAntonov says, use MatrixPlot: matrix = {{ 1, -1, 1, 1, -1}, {-1, -1, -1, 1, 1}, { 1, 1, 1, -1, 1}, {-1, 1, -1, 1, -1}, { 1, 1, 1, -1, -1}}; MatrixPlot[matrix, ColorRules -> {-1 -> Orange, 1 -> Darker@Green}, Frame -> False]


5

That was a simple question. Anyway, providing an answer, maybe someone will find it useful ToeplitzMatrixQ[A_] := Module[{c, r, a}, c = A[[All, 1]]; r = A[[1, All]]; a = ToeplitzMatrix[c, r]; Norm[a - A] == 0 ]


5

I misunderstood the meaning of square color before, here is my new answer: matrix = Array[RandomChoice[{-1, 1}] &, {10, 10}]; positionA = Position[matrix, 1]; positionB = Position[matrix, -1]; Grid[matrix, Frame -> All, Background -> {None, None, Join[Rule[#, Green] & /@ positionA, Rule[#, Orange] & /@ positionB]}, ItemStyle -&...


5

This type of n-by-n matrix can be created with SparseArray and Band. n = 4; a = SparseArray[{Band[{1, 2}] -> 1, Band[{n, 1}, Automatic, {0, 1}] -> ToExpression@Table["-\[Alpha]" <> ToString[i - 1], {i, n}]}, {n, n}]; Then, MatrixForm[a] $$\left ( \begin {array} {cccc} 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ ...


4

ClearAll[mat1] mat1[n_] := Array[If[# == n, -Subscript[α, #2], Boole[# == #2]] &, {n, n}, {1, 0}] mat1[5] // MatrixForm // TeXForm $\left( \begin{array}{ccccc} 0 & 1 & 0 & 0 & 0 \\ 0 & 0 & 1 & 0 & 0 \\ 0 & 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 0 & 1 \\ -\alpha _0 & -\alpha _1 & -\...


4

Look at your matrix: The determinant can be calculated by the sum of the products of the diagonals minus the sum of the products of the anti-diagonals. Now, in the diagonals w only appears in the main diagonal together with 2 zeros. And the 2 anti-diagonals containing w also contain a zero. Therefore, the determinant is a pure number. Note also, even if ...


4

You can use a fitting procedure to find a solution. It's not going to be unique, though. u = RandomReal[1, {3}] v = RandomReal[1, {5}] mat = Array[x, {Length[v], Length[u]}] sol = NMinimize[Total[(mat.u - v)^2], Flatten[mat]]; mat /. Last[sol] Check that the residuals are 0: mat.u - v /. Last[sol]


4

Yet another way to get the companion matrix: coeff = Array[a, 4, 0]; mat = ReplacePart[ DiagonalMatrix[ConstantArray[1, Length@coeff - 1], 1], -1 -> -coeff] $$\left( \begin{array}{cccc} 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1 \\ -a(0) & -a(1) & -a(2) & -a(3) \\ \end{array} \right)$$ There is a ...


4

Maybe this? matrix = {{1, 0, 2, 0, 1, 1}, {1, 1, 0, 1, 2, 1}, {1, 0, 0, 2, 1, 1}, {1, 1, 1, 2, 1, 1}, {2, 1, 1, 0, 1, 1}, {1, 2, 1, 2, 2, 1}, {2, 1, 1, 2, 1, 2}, {1, 2, 1, 1, 1, 1}, {0, 1, 1, 0, 1, 0}, {0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}}; matrix // MatrixForm submatrixs = DeleteDuplicates@ Select[Table[matrix[[i]],...


3

array = Array[Subscript[m, ##] &, {8, 5}]; {checkmark, dot} = {"✓", "\[FilledSmallCircle]"}; labeledcells = Join[Thread[{1, Range[5]}], {{2, 1}, {8, 1}}]; markedcells = {{2, 2}, {4, 3}, {6, 5}}; dottedcells = Complement[Tuples[{Range[8], Range[5]}], labeledcells, markedcells]; array2 = ReplacePart[array, {markedcells :> checkmark,...


3

Given m = {{P, p, 0, 0}, {p Indexed[e, 1], P Indexed[e, 1], s Indexed[q, 1], s Indexed[r, 1]}, {p Indexed[e, 2], P Indexed[e, 2], s Indexed[q, 2], s Indexed[r, 2]}, {p Indexed[e, 3], P Indexed[e, 3], s Indexed[q, 3], s Indexed[r, 3]}} and simply changing inverse to Inverse and adding Simplify: im = Inverse[m] // Simplify I get Then evaluating im....


3

A variation on Anton's cool idea: ClearAll[bsf, scribleShading] bsf[n_: 200][t_] := BSplineFunction[Transpose[Rescale /@ Transpose[ Table[{x, RandomReal[{-.2, .2}] + (Pi - Abs[x - Pi]) RandomReal[{.75, 1}] Sin[30 x]}, {x, Sort@RandomReal[{0, 2 Pi}, n]}]. RotationMatrix[ RandomReal[Pi/4 + {-Pi/32, Pi/32}]]]], SplineDegree -> 7][t]; ...


3

Yet another way: Graphics[{ Raster[Reverse@matrix, ColorFunction -> (Blend[{Orange, Darker@Green}, #] &)] }, GridLines -> Automatic, GridLinesStyle -> Directive[Thick, Black], Method -> {"GridLinesInFront" -> True}, PlotRangePadding -> None]


3

Table is easy to understand. Table[Which[i - 1 == j, 1, j == #, - α[i - 1], True, 0], {j, 1, #}, {i, 1, #}] &@5 $$ \begin{bmatrix} 0 & 1 & 0 & 0 & 0 \\ 0 & 0 & 1 & 0 & 0 \\ 0 & 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 0 & 1 \\ -\alpha (0) & -\alpha (1) & -\alpha (2) & -\alpha (3) & ...


3

With[{n = 5}, SparseArray[{{i_, j_} /; j == i + 1 -> 1, {n, j_} -> -Subscript[α, j - 1]}, {n, n}]]; % // MatrixForm


3

Join[b, i, 2] ArrayFlatten[{{b, i}}] ArrayPad[b, {{0}, {0, 2}}, i] MapThread[Join, {b, i}] all give {{1, -1, -1, -1, 1, 0}, {1, 1, -1, 1, 0, 1}} TeXForm @ MatrixForm @ % $$\left( \begin{array}{cccccc} 1 & -1 & -1 & -1 & 1 & 0 \\ 1 & 1 & -1 & 1 & 0 & 1 \\ \end{array} \right)$$ Note: You can use IdentityMatrix[...


3

There are too many matrixs satisfy the equation M.u==v. Without loss general, we can Normalize the vector u and v. Besides the RotationMatrix which have mention by @Daniel Huber, we can construct the reflect-matrix by hand which also satisfiy the equation M.u==v u = Normalize[{x, y, z}, Sqrt[#.#] &]; v = Normalize[{a, b, c}, Sqrt[#.#] &]; normal = ...


2

You may search for a rotation matrix that turns the direction of u into the direction of v. Applying this matrix to u gives a vector in the direction of v, but with a different length. Therefore you must adjust the rotation matrix by multiplying by the length of v and divide by the length of u. THis can be done in MMA by: {u, v} = RandomReal[{-1, 1}, {2, 3}] ...


2

To make it simple, I use latin characters instead of greek ones: a1,at,ar and g1,gt,gr. Note, this variables are now square matrices of any dimension. Then we may calculate t1 and r1 by the time honoured "manual" method like (I assume that the matrices are invertible): Clear[a1, at, ar, g1, gt, gr, t1, r1]; eq1 == a1 + at.t1 + ar. r1 == 0 ; iar.a1 +...


2

This would be one option ClearAll["g*"]; g[M_List /; Length[Dimensions[M]] === 2]:=Array[{x,y}\[Function](Symbol[StringJoin[Flatten@{"g",ToString/@Sort[{x,y}]}]][##]&@@Flatten[M]),Dimensions[M]] which for x = {{x11, x12}, {x21, x22}}; g[x] // MatrixForm results in { {g11[x11,x12,x21,x22,x31,x32,x41,x42],g12[x11,x12,x21,x22,x31,...


2

In addition to Natas' answer, you could also try: kp[m_, k_] := Nest[KroneckerProduct[#, m] &, m, k - 1] or kp[m_List, k_Integer?Positive] := Nest[KroneckerProduct[#, m] &, m, k - 1] These should give you the exact same answer. Using Nest doesn't really save you any characters over Table, but it is a useful function so I thought I'd use it here. ...


2

You can also use ArrayMesh: ArrayMesh[matrix, MeshCellStyle -> {{2, All} -> Darker@Green, {2, PositionIndex[Flatten @ matrix] @-1} -> Orange}] ArrayMesh[matrix, MeshCellStyle -> {{2, All} -> Darker @ Green, {2, PositionIndex[Flatten@matrix]@-1} -> Orange}, MeshCellLabel -> MapIndexed[{2, #2[[1]]} -> Style[#, 20] &, ...


2

I assume your matrices are just an identity and its tensor product with itself reshaped into a matrix: A = IdentityMatrix[3]; B = ArrayReshape[TensorProduct[A, A], {9, 9}]; If you treat them like this, then it's only one contraction: TensorContract[TensorProduct[A, B], {{3, 4}}] But I think this would be more faithful to your mathematical notation of ...


2

Alternatives faster than OP's ToeplitzMatrixQ: ClearAll[toeplitzQ1, toeplitzQ2, toeplitzQ3] toeplitzQ1 = # == ToeplitzMatrix[#[[All, 1]], #[[1]]] &; toeplitzQ2[m_?SquareMatrixQ] := AllTrue[Diagonal[m, #] & /@ Range[-# + 1, # - 1]&[Length@m], Statistics`Library`ConstantVectorQ] toeplitzQ3[m_?SquareMatrixQ] := Max[Length[Union[Diagonal[m, #]]...


1

\[Sigma]p=Sum[PauliMatrix[i]*Symbol["p"<>ToString[i]],{i,1,3}] Id2=IdentityMatrix[2]; O2=IdentityMatrix[2]*0; wExp=(IdentityMatrix[4]+ArrayFlatten[{{\[Sigma]p/(e+m),O2},{O2,-\[Sigma]p/(e+m)}}])*Sqrt[(e+m)/(2m)]; %//MatrixForm results in while \[Sigma]phat=Sum[PauliMatrix[i]*Symbol["phat"<>ToString[i]],{i,1,3}]; PExp=(...


1

Just fooling around, simply for the sake of speed: matrix = Developer`ToPackedArray@{{1, 0, 2, 0, 1, 1}, {1, 1, 0, 1, 2, 1}, {1, 0, 0, 2, 1, 1}, {1, 1, 1, 2, 1, 1}, {2, 1, 1, 0, 1, 1}, {1, 2, 1, 2, 2, 1}, {2, 1, 1, 2, 1, 2}, {1, 2, 1, 1, 1, 1}, {0, 1, 1, 0, 1, 0}, {0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}}; submat = ...


1

P={{1,2},{3,4}}/10; im={{1},{1}} A=ArrayFlatten[{{KroneckerProduct[im\[Transpose],IdentityMatrix[2]]},{KroneckerProduct[IdentityMatrix[2],im\[Transpose]]}}] p=Flatten[P] A.p a typo: in -> im Don't use MatrixForm during calculation, unless you know it.


1

Clear["Global`*"] mat = {{(Sqrt[ m] ((m + Sqrt[m^2 + p^2])/m)^(3/2) (Sqrt[m^2 + p^2] p0 p3 + m^2 (p0 + p3) + p^2 (Sqrt[m^2 + p^2] + p0 + p3) + m (p^2 + Sqrt[m^2 + p^2] p3 + p0 (Sqrt[m^2 + p^2] + p3))))/(m + Sqrt[m^2 + p^2])^(5/ 2), (Sqrt[ m] ((m + Sqrt[m^2 + p^2])/m)^(3/ 2) (p^2 + (...


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