Tag Info

New answers tagged

0

This seems to work. kmat = {{3 - 3 w, -4/3 + a + 2 w, 5/12 + b - w/2, 0}, {-4/3 + a + 2 w, -1 - 6 a - 3 x, 3/4 + 3 a - 3 b + 2 x - y/2, -2/3 - a - x/2 + z/2}, {5/12 + b - w/2, 3/4 + 3 a - 3 b + 2 x - y/2, -1/2 + 6 b, 19/12 - b + y/2 - 2 z}, {0, -2/3 - a - x/2 + z/2, 19/12 - b + y/2 - 2 z, -3 + 3 z}}; vec = Array[t, Length[kmat]]; ...


0

You can also define your own function if you want to apply it to multiple cases myFunc = ArrayFlatten@MapThread[List, {{K11e[#], K21e[#]}, {K12e[#], K22e[#]}}, 1] & myFunc@1 // MatrixForm


1

You should use ArrayFlatten to build block matrices, for example {{K11e[1], K12e[1]}, {K21e[1], K22e[1]}} // ArrayFlatten


3

The result is the same. V10 presentation is just went wrong somewhere, but it is the same value as v9. I copied v9 result to v10 and compared the real and the imaginary parts. Clear[t]; expr = {{0, 1/2, 0, 0, 1/2}, {1/2, 0, 1/2, 0, 0}, {0, 1/2, 0, 1/2, 0}, {0, 0, 1/2, 0, 1/2}, {1/2, 0, 0, 1/2, 0}}; v10 = MatrixExp[-I t expr]; v9 = (*copied from v9 ...


1

The answer is that it's mathematically impossible to do what you ask in a general setting. As a counter-example, consider how you would bring the 3-dimensional unit matrix into anti-diagonal form. It would require a permutation with signature Signature[{3, 2, 1}] (* ==> -1 *) so that the determinant of the anti-diagonal matrix has the opposite sign as ...


1

Would you be happier with this? Eigensystem[{{0.9, 0.5}, {0.1, 0.5}} // Rationalize] {{1, 2/5}, {{5, 1}, {-1, 1}}}


0

Reverse each row: B = Reverse/@ A


1

The Eigenvalues are represented as Roots of a polynomial equation which is in turn expressed using the #'s. This is normal and correct. If you enter numbers for the parameters of your matrix and apply N[] to your Eigenvalues the #'s will vanish.


0

I figured following approach works. Use << FiniteFields` Then define matrix regularly as over reals however with keyword $GF[2]$ just before matrix. Now computation seems to happen over $GF[2]$.


1

Here is one approach. I have not tested it so there might be unforseen hitches. I'll refer to your matrices as matrixA, matrixB1, and matrixB2 respectively. Define minEig[mat1:{{_Real..}..},mat2:{{_Real..}..}] := Min[Eigenvalues[mat1-mat2]] newB = Array[b, Dimensions[a]]; obj = Trace[matrixA.newB]; FindMinimum[{obj, minEig[newB,matrixB1]>=0, ...


1

You can also do Refine[Conjugate@c[[1]], Assumptions->(\[Alpha] | \[Beta] | \[Phi]) \[Element] Reals] This also works in cases when you have additional manifestly complex variables in your expression (ComplexExpand assumes that all variables are real). Of course in that case you would not add those in your Assumptions. For example: ...


7

Is this what you wanted? expr = E^(-((I \[Beta])/2)) p (Cos[\[Alpha]/2] (Cos[\[Theta]]^2 + Sin[\[Theta]]^2 Sin[\[Phi]] (-I Cos[\[Phi]] + Sin[\[Phi]])) + E^(I \[Beta]) Sin[\[Alpha]/2] (Cos[\[Theta]]^2 + Sin[\[Theta]]^2 Sin[\[Phi]] (I Cos[\[Phi]] + Sin[\[Phi]]))) expr /. Complex[x_, y_] :> Complex[x, -y]


1

You might use: FullSimplify@ComplexExpand@Conjugate[(* expression *)] in your case, it returns: $$ e^{\frac{i \beta }{2}} p \left(\sin \left(\frac{\alpha }{2}\right) e^{-i (\beta -\phi )} \left(\cos ^2(\theta ) \cos (\phi )-i \sin (\phi )\right)+\cos \left(\frac{\alpha }{2}\right) \left(\cos ^2(\theta )+\sin ^2(\theta ) \sin (\phi ) (\sin (\phi )+i ...


2

Times @@ Eigensystem[{{2, 0}, {0, 6}}] (* {{0, 6}, {2, 0}} *) Or... Times @@ (N@Eigensystem[{{3, 4}, {1, 2}}]) (* {{11.6847, 4.56155}, {-0.684658, 0.438447}} *)


1

You can do it as Assuming[ {s0 > 0, s1 > 0, s2 > 0, s3 > 0, s4 > 0, s5 > 0, s6 > 0, s7 > 0, s8 > 0}, Inverse[{{s0, s1, s2}, {s3, s4, s5}, {s6, s7, s8}}]]  For instance, If you get $s0=-1$, then you will get the error $Assumptions::fas: Warning: one or more assumptions evaluated to False.. Also you can determine the condition ...


4

By taking advantage of the trigonometric identity, 2 Sin[m π χ] Sin[p π χ] == Cos[(m - p) π χ] - Cos[(m + p) π χ] the number of integrals to be performed can be reduced from Nmax^2 to 2*Nmax+1, as savings of nearly a factor of 40 for Nmax = 80. Nmax = 80; dct = Table[Integrate[Cos[i π χ] V[χ], {χ, 0, 1}], {i, 0, 2 Nmax}]; Hmp = Table[(p^2 π^2)/2 ...


0

Another interesting old-ish question that popped into the sidebar (Not even sure why no upvotes on it - it is an interesting question!) My take: I refactored Kguler's pickPosF, simply changing to mypickPosF[{ax_, bx_}] := (Function[{xx}, First[Pick[Range[Length[bx]], UnitStep[bx - xx], 1] /. {} -> {0}]] /@ ax) This improved performance ...


4

In addition to using Solve one can augment the matrix by a row containing the modulus in each position and use HermiteDecomposition. Any zero row (modulo the modulus) in the resulting HNF corresponds to a null vector in the conversion matrix. i1 = IntervalDifferenceMatrix[{{0}, {1}, {4}}]; i2 = Append[i1, ConstantArray[12, 3]]; {uu, hnf} = ...


3

The way you've written things, you're passing an exact matrix to Eigenvalues and then finding a numerical approximation afterwards, so Mathematica is trying to compute an exact answer algebraically. For a 1000 × 1000 matrix, this obviously takes a while. In order to get an answer more quickly, find the numerical approximation first and then find the ...


3

Use N on the matrix itself n = 1000; m = SparseArray[{Band[{1, 2}] -> 1, Band[{2, 1}] -> 1, Band[{2, 2}, {n - 1, n - 1}] -> 2, {1, 1} -> 2, {n, n} -> 2, {1, n} -> 0, {n, 1} -> 0}, {n, n}]; AbsoluteTiming[Eigenvalues[N@m]] {0.489062, {3.99999, 3.99996, 3.99991, 3.99984, 3.99975, 3.99965, 3.99952, 3.99937, 3.9992,....


5

The MapIndexed function works very nicely for this, as it provides both the value of the array element, and a list representing its position. I wasn't golfing here, so I used pattern matching on function arguments for the rest: draw[0, _] = {}; draw[v : Except[0], {x_, y_}] := {v /. {0.5 -> Green, 1 -> Red}, Sphere[{x, 6 - y, 0}]}; Graphics3D[{ ...


2

Using Map, you can avoid looping: Graphics3D[{Opacity[0.5], {Red, Sphere /@ (Position[M, 1] /. {x_, y_} :> {x, 6 - y, 0})}, {Green, Sphere /@ (Position[M, .5] /. {x_, y_} :> {x, 6 - y, 0})}}] or a little shorter (but more nerdy): Graphics3D[{Opacity[0.5], ...


2

Operation on m itself: m[[{3, 4}]] *= {.8, 1.2}; m[[All, 2 ;; -2]] = Transpose[Normalize[#, Total] & /@ Transpose[m[[All, 2 ;; -2]]]]; m // MatrixForm after a talk, if you want to normalize (with Total norm) rows then skip transposing: m[[2 ;; -2]] = Normalize[#, Total] & /@ m[[2 ;; -2]]; and if you don't want to modify m you can do: Fold[ ...


1

list = {{1., 0., 0., 0., 0, 0}, {0, 0.538752, 0.382352, 0.0788956, 2.35142*10^-7, 0}, {0, 0.121876, 0.449018, 0.405176, 0.0239311, 0}, {0, 0.0147839, 0.264751, 0.596752, 0.123713, 0}, {0, 0, 0.0294091, 0.381909, 0.563762, 0.0249205}, {0, 0, 0., 0., 0., 1.}}; list2 = {1, 1, 0.8, 1.2, 1, 1} list; Transpose[MapAt[#/Total[#] &, ...


2

Not acquainted with the SSA algorithm, but I tried to decipher it from your code. Please modify to fix it in your final work. If is not best practice in Mathematica to use For statements, so the following approach is taking advantage of the NestList Command. (*Define the function that will provide the vector state after the next event occured*) ...


1

ClearAll[filterF]; filterF[mat_, cornerneighbors_: True] := Block[{ker = If[cornerneighbors, 1 - BoxMatrix[0, 3], {{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}]}, Developer`PartitionMap[If[FreeQ[ker #, 1], #[[2, 2]], 0] &, mat, {3, 3}, 1, 2, mat]] Using Mr.Wizard's example: SeedRandom[0]; mat = RandomChoice[{4, 1} -> {0, 1}, {10, 10}]; ...


0

matrix = Array[M, {3, 3}]; soln = {{M[1, 2] -> Cos[\[Psi][t]], M[1, 3] -> 0, M[2, 3] -> 0, Cos[\[Theta][t]] -> M[3, 1], M[3, 2] -> 0, M[3, 3] -> 1, M[2, 1] -> -Cos[\[Psi][t]] Sin[\[Theta][t]], M[2, 2] -> Sin[\[Psi][t]], M[1, 1] -> Sin[\[Theta][t]] Sin[\[Psi][t]]}}; To reverse rules that are in "wrong" ...


1

You can try NSolve since this is non-linear. But it might not be able to solve it. Find root can. Also, if you know range of solution expected, it might help. m = 3; A0 = RandomReal[{0, 1}, {m, m}]; B0 = RandomReal[{0, 1}, {m, m}]; x = {x1, x2, x3}; C0 = RandomReal[{0, 1}, m]; eq = Thread[A0.x + B0.Exp[x] == C0]; FindRoot[eq, {{x1, 0}, {x2, 0}, {x3, ...


1

Generally: Yes, as long as you actually give the matrices a and b, as well as the vector c. With their elements named as usual x={x1,x2} etc., you then just do: Solve[a.x + b.Exp[x] == c,{x1,x2}] Example: With a={{1,0},{0,1}}, b={{0,1},{1,0}}, c={c1,c2}, x={x1,x2} this will give you the solution: {{x1 -> -I \[Pi] + Log[-c2 + x2]}} i.e.: you are ...


0

project euler 28 This is a pad version, padMatrix is written a bit complex. f[x_] := 1/4 (-1)^x (1 + 3 (-1)^x + 2 (-1)^x x) padMatrix[x_, pad_, type_: 0] := Which[type == 1, Append[x\[Transpose], pad]\[Transpose], type == 2, Append[x, Reverse@pad]\[Transpose], type == 3, Prepend[x, Reverse@pad], type == 4, Prepend[x\[Transpose], pad]] ...


1

I think you are looking for Replace: p4 - p5 == r45 i45 /. r45 -> 1 (* p4 - p5 == i45 *) % /. lhs_ == rhs__ -> rhs - lhs == 0 (* i45 + p5 - p4 == 0 *)


3

It depends on how PBS and the cluster environment are set up. Ideally, if cpuset support has been compiled in to PBS, and if you start Mathematica directly inside the PBS job, you should find that it uses all processors allocated by PBS (on that node--Eigensystem is not MPI-parallelized). If cpuset support isn't provided, then you risk starting as many ...


5

First a simpler way to get your first example: (m = ArrayFlatten[Transpose /@ {{v1, v2, v3}, {v4, v5, v6}}, 1]) // MatrixForm An alternative way to do @bill's undoing trick: (m2 = ArrayFlatten[Transpose /@ {{v1, ## & @@ Transpose[vNew]}, {v4, v5, v6}}, 1]) // MatrixForm Using ArrayReshape as an alternative to ArrayFlatten: ...


3

How about just breaking up the matrix and then reconstructing the same way. Here are your source vectors v1 = {1, 2, 3}; vNew = {{4, 5}, {6, 7}, {8, 9}}; v4 = {10, 11, 12}; v5 = {13, 14, 15}; v6 = {16, 17, 18}; So now define and reconstruct: {v2, v3} = Transpose[vNew]; ArrayFlatten[{Transpose@{v1, v2, v3}, Transpose@{v4, v5, v6}}, 1] // MatrixForm If ...


5

TL;DR; myArrayFlatten = Flatten /@ Flatten[#, {{1, 3}}] & {x,y,z} or {{x},{y},{z}} is considered column vector. Usage example: v1 = {1, 2, 3}; vNew = {{4, 5}, {6, 7}, {8, 9}}; v4 = {10, 11, 12}; v5 = {13, 14, 15}; v6 = List /@ {16, 17, 18}; { {v1, vNew, v1}, {v4, v5, v6, v1}, {vNew, vNew} } // myArrayFlatten // MatrixForm Flatten ...


1

A = {{0.1, 0}, {0, 0.1}}; B = {{2, 3}, {-3, 1}}; c = {{0.2, 0.6}, {0.2, 0}}; d = {2, 3}; e = {1, 0}; i = {{1, 0}, {0, 1}}; g[11] = {0, 0}; g[t_] := A.S[t+1].Inverse[i-B.S[t+1]].(B.g[t+1]-d)+A.g[t+1]+e; p[11] = {0, 0}; p[t_] := S[t].X[t] - g[t]; S[11] = {{0, 0}, {0, 0}}; S[t_] := c + A.S[t + 1].Inverse[i - B*S[t + 1]].A ; X[1] = {1, 0}; X[t_] := Inverse[i - ...


2

Seeing you asked about how to drop the first or last rows/columns, you can do that conveniently with Most and Rest: Most@m (* drops last row *) Most/@m (* drops last column *) Rest@m (* drops first row *) Rest/@m (* drops first column *)


5

Okay, following the "bare bones" approach for dropping rows and columns here are a few ideas. Starting matrix: m = Array[Times, {5, 6}] $\left( \begin{array}{ccccc} 1 & 2 & 3 & 4 & 5 \\ 2 & 4 & 6 & 8 & 10 \\ 3 & 6 & 9 & 12 & 15 \\ 4 & 8 & 12 & 16 & 20 \\ \end{array} \right)$ Part ...


2

A barebones example for the desired cropping is: m = Array[Subscript[a, ##] &, {4, 4}]; MatrixForm[m] $$\left( \begin{array}{cccc} a_{1,1} & a_{1,2} & a_{1,3} & a_{1,4} \\ a_{2,1} & a_{2,2} & a_{2,3} & a_{2,4} \\ a_{3,1} & a_{3,2} & a_{3,3} & a_{3,4} \\ a_{4,1} & a_{4,2} & a_{4,3} & a_{4,4} \\ ...


1

a = {{a1, a2}, {a3, a4}}; b = {{b1, b2}, {b3, b4}}; c = {{c1, c2}, {c3, c4}}; s[11] = {{0, 0}, {0, 0}}; s[10] = c + a.s[11].Inverse[IdentityMatrix[2] - b.s[11]].a which immediately returns {{c1, c2}, {c3, c4}} Trying to use upper case characters, like C, for variable names results in errors. Trying to use "abstract" vectors and matricies results in ...


2

With a = {{0.1, 0}, {0, 0.1}}; b = {{2, 3}, {-3, 1}}; c = {{0.2, 0.6}, {0.2, 0}}; i = {{1, 0}, {0, 1}}; and s[t_] := {{s11[t], s12[t]}, {s21[t], s22[t]}} one can see that s12 and s21 don't depend on t by evaluating c + a*s[t + 1]*Inverse[i - b*s[t + 1]]*a Therefore I set s[11] = {{0, 0.6}, {0.2, 0}} Redefining s with s[t_] := s[t] = c + a*s[t ...


3

Update: You can also use Part Det[mat[[#, #]]] & /@ Reverse[Subsets[Range[Length@mat] , {3}]] (* {-36, -288, -252, -24} *) Grid[{MatrixForm@#, Det@#} & /@ (mat[[#, #]] & /@ Reverse[Subsets[Range[Length@mat] , {3}]]), Dividers -> All] Determinants of 2X2 submatrices on the diagonal: Grid[{MatrixForm@#, Det@#} & /@ (mat[[#, #]] ...


0

Diagonal @ Minors[mat] (* {-24, -252, -288, -36} *)


0

A way to solve this is making the following change the fourth line into b = b /. {Subscript[be, 1] -> 1, Subscript[be, k_] :> (-1)*Subscript[be, k] /; k > 1} where we have taken the negative one out the Subscript function. This came from the kind comment by @bills that Subscript is mostly a formatting function whose output can become the ...


4

Using the built-in matrix manipulation commmands mat = Array[Subscript[a, ##] &, {4, 4}]; LowerTriangularize[mat] + Transpose[LowerTriangularize[mat]] - DiagonalMatrix[Diagonal[mat]] gives the same answer. This takes the lower triangular part and adds it to the transpose of itself, giving a symmetric matrix in which the diagonal entries have been ...


5

You could define it with Array[Subscript[a, Min[##], Max[##]] &, {4, 4}]


4

You can apply a rule using Condition: mat2 /. Subscript[a, i_, j_] :> Subscript[a, j, i] /; j > i giving $$\left( \begin{array}{cccc} a_{1,1} & a_{2,1} & a_{3,1} & a_{4,1} \\ a_{2,1} & a_{2,2} & a_{3,2} & a_{4,2} \\ a_{3,1} & a_{3,2} & a_{3,3} & a_{4,3} \\ a_{4,1} & a_{4,2} & a_{4,3} & a_{4,4} \\ ...


1

Try f[x_, y_] = Block[{x, y}, Assuming[x ∈ Reals && y ∈ Reals, Log[Det[V[x, y]\[ConjugateTranspose].V[x, y]]] /. e : Conjugate[EllipticTheta[a_, z_, q_]] :> EllipticTheta[a, Conjugate[z], q] // Simplify ] ]; Chop[N[Q[1, 1]]] (* 2.10739 *)



Top 50 recent answers are included