Hot answers tagged

10

Edit 03 Here's a function to wrap all this up and answer the latest questions in the comments. Some utility functions: makePeriodicLattice2D[pts_, {sizeH_, sizeV_}] := With[{d = ArrayDepth[pts]}, Transpose[ MapThread[ Mod[#1, #2, -#2/2] &, {Transpose[pts, RotateLeft[Range[d]]], {sizeH, sizeV}}], RotateRight[Range[d]]]] ...


8

We can add a second argument to TorusGraph to specify the number of segments between nodes with integer coordinates in each dimension: ClearAll[torusGraph] torusGraph[dims : {__Integer}, segs: {__Integer} : {1, 1}, opts : OptionsPattern[Graph]] := Module[{m = Length[dims], tg}, tg = Graph[Flatten[Array[Table[Rule @@@ Partition[Function[x, Mod[{##}...


7

B == ArrayReshape[Transpose[ArrayReshape[A, {3, 3, 3}]], {3, 9}] True Also, in loop style: result = ConstantArray[0, {3, 9}]; Do[ result[[i, 3 (j - 1) + k]] = A[[j, 3 (i - 1) + k]], {i, 1, 3}, {j, 1, 3}, {k, 1, 3} ]; result == B True Or with a permutation matrix of size $27 \times 27$: P = Block[{A, B, a}, A = Array[a, {3, 9}]; B = ...


7

You can use LinearSolve to find one possible matrix such that A.X==B: X = LinearSolve[A, B]; A.X == B // FullSimplify (* True *)


6

Edit Another way is use perturbation. u = {0, 1, 0}; v = {0, -1, 0}; m = Limit[RotationMatrix[{u, v + t*RandomInteger[20, 3]}], t -> 0] {{0, 0, -1}, {0, -1, 0}, {-1, 0, 0}} {{-(87/425), 0, -(416/425)}, {0, -1, 0}, {-(416/425), 0, 87/425}} etc. Original We can find an orthogonal matrix satisfied $m^{T}\bullet m=\mathrm{Id},\mathrm{Det}(m)=1$ which ...


5

As suggested in the comment, you should use Part and ArrayReshape: (* Create random 3D matrix with dimensions 11 x 1000 x 3 *) mat = RandomReal[1, {11, 1000, 3}]; Dimensions[mat] (* {11, 1000, 3} *) mat2 = mat[[All, 11 ;;, All]]; Dimensions[mat2] (* {11, 990, 3} *) mat3 = ArrayFlatten[mat2, 1]; Dimensions[mat3] (* {10890, 3} *)


4

Clear["Global`*"] Use an indexed variable and you can easily generate the result without the original matrix. The variable C is used by Mathematica so use c instead. You can display c as C if desired. Format[c[m_, n_]] := Subscript[C, 10 m + n] (EDIT: Or as suggested by LouisB, for larger arrays use Format[c[m_, n_]] := Subscript[C, Row[{m, n}, &...


3

One tricky thing to keep in mind is that in Mathematica a vector is always 1 dimensional, so it's not automatically treated as an n by 1 matrix. Because of this, the distinction between column and row vectors disappears and this affects some matrix operations. For example, consider: u = {a, b, c}; KroneckerProduct[u, IdentityMatrix[3]] // Dimensions ...


3

There is no concept of "transposed vector" in Mathematica. To illustrate, let's give your variables concrete values: Ip = {{Ixx, Ixy, Ixz}, {Ixy, Iyy, Iyz}, {Ixz, Iyz, Izz}}; ω = {ωx, ωy, ωz}; Your $Q$ is simply Q = ω . Ip . ω // Expand (* Ixx ωx^2 + 2 Ixy ωx ωy + Iyy ωy^2 + 2 Ixz ωx ωz + 2 Iyz ωy ωz + Izz ωz^2 *) and its gradient with ...


2

(** some fake data - a matrix of: {{x1,y1,f[x1,y1]}, {x2,y2,f[x2,y2]}, ..., {xn,yn,f[xn,yn]}} **) SeedRandom[1]; f[{x_, y_}] := {x, y} . {1, 1}^2 data = Append[#, f[#]] & /@ RandomReal[1, {10, 2}]; (* get a TemperatureMap and scale f[x,y] into [0,1] *) cf = ColorData["TemperatureMap"]; colsScaled = cf /@ Rescale[data[[All, 3]]]; ...


2

KeyValueMap[{colnames[[#]], ## & @@ #2} &] @ GroupBy[Thread[rownames -> (PositionIndex[#][1] & /@ data)], Last -> First] {{{c1}, S0}, {{c6}, S1, S8}, {{c12}, S2, S3, S4}, {{c5, c9, c10, c11, c12}, S5, S6, S7}} You can also do: Values @ GroupBy[Thread[rownames -> (PositionIndex[#][1] & /@ data)], Last, {colnames[[...


2

Export the components of the output matrices individually by changing the export section from SMSExport[OutputMatrix1,output1$$]; SMSExport[OutputMatrix2,output2$$]; SMSExport[OutputMatrix3,output3$$]; to SMSExport[OutputMatrix1, Table[output1$$[i, j], {i, 1, ndim}, {j, 1, ndim}]]; SMSExport[OutputMatrix2, Table[output2$$[i, j], {i, 1, ndim}, {j, 1, ndim}]];...


2

Try this Table[If[row>col,Subscript[c,col,row],Subscript[c,row,col]],{row,1,6},{col,1,6}] and if you need that formatted to look at then %//MatrixForm As requested, remove the commas Table[If[row>col,Subscript[c,10*col+row],Subscript[c,10*row+col]],{row,1,6},{col,1,6}] but that will break if you have more than 9 columns and rows. You could then try ...


2

I think you mean this m = {{1, 2, 1}, {1, 1, 0}, {1, 1, 1}} aa = Array[a, {3, 3}] y = {y1, y2, y3} z = {y1 + 2*y2 + y3, y1 + y2, y1 + y2 + y3} sa = First@SolveAlways[Thread[aa.y == z], y] aa /. sa // MatrixForm m == aa /. sa (* True *)


2

m0 = UpperTriangularize @ Array[Symbol @ StringRiffle[{"C", ##}, ""] &, {6, 6}]; TeXForm @ MatrixForm @ m0 $\left( \begin{array}{cccccc} \text{C11} & \text{C12} & \text{C13} & \text{C14} & \text{C15} & \text{C16} \\ 0 & \text{C22} & \text{C23} & \text{C24} & \text{C25} & \text{C26} \\ 0 &...


2

Here are two versions of the same solution. First, using a general 2x2 matrix along the subdiagonal ClearAll[v] v[Nm_] := Block[{array, band}, array = With[{mat = Normal@SparseArray[Band[{2, 1}] -> Array[band, Nm - 1], Nm]}, ArrayFlatten[mat /. {0 -> ConstantArray[0, {2, 2}], band[n_] :> n{{b11, b12}, {b21, b22}}}]]; (array + ...


2

I don't know why the first case does not through an error, but SparseArray expectes the correct dimensions of the array as second argument. So V0 should read as follows: V0[Nm_] := SparseArray[{ Band[{3, 1}] -> Table[V[n], {n, 1, Nm - 1}], Band[{1, 3}] -> Table[ConjugateTranspose[V[n]], {n, 1, Nm - 1}] }, {2 Nm, 2 Nm} ]; The result ...


2

This situation is another reason why I wrote the vectorRotate[] function in this answer, which implements the method of Möller and Hughes: vectorRotate[{0, 1, 0}, {0, -1, 0}] {{-1, 0, 0}, {0, -1, 0}, {0, 0, 1}}


1

Here is a solution using Part Flatten[A[[All, # ;; ;; 3]] & /@ Range@3 // Transpose, 1] // Transpose


1

Should be Subscript[S, 1] = KroneckerProduct[PauliMatrix[1], IdentityMatrix[2]] Subscript[S, 2] = KroneckerProduct[IdentityMatrix[2], PauliMatrix[2]] basis = {{0, 0, 0, 1}, (1/Sqrt[2]) {0, 1, 1, 0}, (1/Sqrt[2]) {0, 1, -1, 0}, {1, 0, 0, 0}}; Inverse[basis].Subscript[S, 1].Transpose[basis] Inverse[basis].Subscript[S, 2].Transpose[basis] {{0, 1/Sqrt[2], 1/Sqrt[...


1

z = {y1 + 2*y2 + y3, y1 + y2, y1 + y2 + y3}; y = {y1, y2, y3}; m = Array[a, {3, 3}]; eq = ForAll[y // Evaluate, m . y == z]; sol = Resolve[eq] Simplify[m, sol] {{1, 2, 1}, {1, 1, 0}, {1, 1, 1}}


1

You can find $H$ as the only right eigenvector that is not in the nullspace, and $\xi$ as the only left eigenvector that is not in the nullspace: Start with a random setup: SeedRandom[1234]; n = 5; H = RandomVariate[NormalDistribution[], n]; ξ = RandomVariate[NormalDistribution[], n]; M = (ξ.ξ) * KroneckerProduct[H, ξ]; Find the right-eigenvector $H_n$ ...


1

Here is an efficient implementation that works for some simple test cases. It is based on Nearest Kronecker Product, but I believe that the intermediate matrix used there is guaranteed to be be symmetric, if the input matrix is a Kronecker square. kronroot[m_?(MatrixQ[#, NumericQ] &)] := Module[{m1, m2, v1, factor}, m1 = Flatten[Partition[m, Sqrt[...


1

D[A,{X}] will do it because D already operates on all elements of the matrix and the {X} argument (grad) will differentiate w.r.t each part of X. But you'll need to flatten each row to get the form you want: n = 2; m = 3; X = Array[x, n] A = Array[a[#1, #2] @@ X &, {n, m}]; (Flatten /@ D[A, {X}]) // MatrixForm


1

With a few bells and whistles Clear["Global`*"] SeedRandom[1]; f[{x_, y_}] := {x, y} . {1, 1}^2 data = Append[#, f[#]] & /@ RandomReal[1, {10, 2}]; {zmin, zmax} = MinMax[data[[All, 3]]] (* {0.3071, 1.80233} *) Legended[ Graphics[{ PointSize[Large], {ColorData["TemperatureMap"][ Rescale[#[[3]], {zmin, zmax}]], ...


1

There was a bug in Matlab export that has been recently removed. Yust, update your AceGen.


1

As mentioned in the comments, the issue is premature evaluation of the product between coeff and x[t]. Before NDSolve evaluates x[t] with the initial condition, it performs coeff*x[t] = {{0,x[t],x[t]}, {x[t],0,x[t]},{x[t],x[t],0}} Then when it substitutes in the initial condition, each of those x[t]s becomes a matrix and you end up with a mess. The idea is ...


1

Update For the modified question, you could use SatisfiabilityInstances: partitionedLists[w_, A_?MatrixQ] := Module[{dim=Dimensions[A], a, x, v, f, i}, (* array of variables *) a = Array[x, dim]; (* variable list, transposed so that column 1 variables come before column 2, etc *) v = Flatten @ Transpose @ a; i = ...


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