Tag Info

New answers tagged

1

You can generate such matrices using the following code: n = 8; MatrixForm[ Table[Piecewise[{{\[Alpha], i == j}, {\[Beta], Abs[i - j] == 1 || Abs[i - j] == n - 1}}], {i, n}, {j, n}]] which generates $$\left( \begin{array}{cccccccc} \alpha & \beta & 0 & 0 & 0 & 0 & 0 & \beta \\ \beta & \alpha & \beta ...


2

If you are going to work with non-commutative algebras like the matrix multiplication I recommend you try the NCAlgebra package. << NC` << NCAlgebra` (2 a) ** (3 b) 6 a ** b P.S. In NCAlgebra all lowercase variables are non-commutative by default.


1

Given a matrix mat replace the 0s in mat with an expression that depends on the indices. randommatrix = RandomInteger[1, {6, 6}]; randommatrix // MatrixForm MapIndexed[# /. {(0) -> Quiet@Style[Evaluate[diff2 @@ #2], Red], _ :> 0} &, randommatrix, {2}] // MatrixForm mat = 1 - Unitize[tttt2]; args = Table[{w, Pprobe}, {w, 2.5, 3., 0.1}, ...


0

It would be easier to answer if you gave some examples, but I'll try anyway. As I understand your question, you allocate a large matrix in Fortran and set elements of it to 0 or 1 during execution. In Mathematica, you start with an empty list and append to it during exection. That would require lots of internal allocation and copying and doesn't reflect ...


2

Update Another try arrow = Graphics[{Arrowheads[Small], Arrow[{{0, 0}, {6, 0}}]}, ImageSize -> {50,10}]; product[m_, n_] := Module[{s, t}, {{Subscript[r, n]/m[[n, n]]}, t = MapAt[#/m[[n, n]] &, m, n], Table[ s = Subscript[r, i] - t[[i, n]] Subscript[r, n]; t = MapAt[# - t[[i, n]] t[[n]] &, t, i]; s, {i, n + 1, Length[m]}], t} ...


7

This is not a matter of "force". A Root object represents the exact root of a polynomial that cannot be represented exactly in closed form, or (in the case of cubics and quartics) cannot be represented succinctly. It is not "unsolved"; it is just a way of writing something that is hard or impossible to write down otherwise. If you want to convert cubic or ...


4

Let me reconstruct your Vandermonde matrix: A = Outer[Power, Range[10], Range[0, 3]]; A // MatrixForm Then there are two possibilities to compute SVD: Analytic expressions Numerical values Your input is the integer array so Mathematica choose the first one and try to give your the answer in an analytic form. It returns the result as roots of the ...


1

Just do this. A = {{1, 1, 1, 1}, {1, 2, 4, 8}, {1, 3, 9, 27}, {1, 4, 16, 64}, {1, 5, 25, 125}, {1, 6, 36, 216}, {1, 7, 49, 343}, {1, 8, 64, 512}, {1, 9, 81, 729}, {1, 10, 100, 1000}} // N; {U, S, V} = SingularValueDecomposition[A]; U // MatrixForm S // MatrixForm You can confirm the results. U.S.Conjugate[Transpose[V]] // Rationalize ...


2

Table and MapAt with Span can reduce the code to almost two lines: n = 3; A = RandomInteger[10, {n, n}]; MatrixForm[A] LU = Join[A, IdentityMatrix[n], 2]; res = Table[{LU = MapAt[#/LU[[k, k]] &, LU, k], LU = MapAt[# - #[[k]] LU[[k]] &, LU, k + 1 ;;]}, {k, n}]; Map[augmentedMatrixForm, res, {2}] // Grid With "tags" it is a bit longer LU ...


3

Here are a couple of ways: Cases[mat, {e__, l_} :> {e, l /. rules}] or ReplacePart[mat, {i_, 3} :> (mat[[i, 3]] /. rules)]


4

mat[[All, -1]] = Transpose[mat][[-1]] /. rules; mat {{2, 1, 1000}, {3, 0, 11}, {4, 2, 11}, {2, 0, 33}, {1, 0, 1000}, {0, 0, 11}, {3, 3, 22}, {0, 2, 11}, {0, 1, 11}, {2, 1, 22}}


1

data = RandomInteger[4, {10, 3}]; rules = {0 -> 1000, 1 -> 11, 2 -> 22, 3 -> 33, 4 -> 44}; data /. {a__?NumberQ, b_} :> {a, b /. rules} // MatrixForm


3

If the rule doesn't fit, change it: rules = {a_, b_, #} :> {a, b, #2} & @@@ {0 -> 1000, 1 -> 11, 2 -> 22, 3 -> 33, 4 -> 44}; mat /. rules {{4, 4, 1000}, {4, 1, 1000}, {1, 2, 33}, {3, 1, 1000}, {2, 0, 33}, {4,3, 33}, {2, 1, 11}, {2, 0, 44}, {3, 3, 22}, {1, 2, 22}}


2

With[{m = Transpose[mat]}, Transpose[Append[Most[m], Last[m]/. rules]]]


6

mat = {{2, 1, 0}, {3, 0, 1}, {4, 2, 1}, {2, 0, 3}, {1, 0, 0}, {0, 0, 1}, {3, 3, 2}, {0, 2, 1}, {0, 1, 1}, {2, 1, 2}}; rules = {0 -> 1000 ,1-> 11, 2-> 22, 3 -> 33, 4-> 44}; mat[[All, -1]] = mat[[All, -1]] /. rules; mat (* {{2, 1, 1000}, {3, 0, 11}, {4, 2, 11}, {2, 0, 33}, {1, 0, 1000}, {0, 0, 11}, {3, 3, 22}, {0, 2, 11}, {0, 1, ...


1

Another variant: deleteConsecutive = Split[#][[All, 1]]& deleteConsecutive@{TCC12, TCC12, B96, TM12, TCC12, B96} (* {TCC12, B96, TM12, TCC12, B96} *)


1

f = #1 & @@@ Split @ # &; x = {TCC12, TCC12, B96, TM12, TCC12, B96}; f@x (* {TCC12,B96,TM12,TCC12,B96} *) m = {{1, 1, 1, 1}, {2, 2, 0, 2}, {0, 1, 0, 0}, {2, 2, 0, 0}}; f /@ m (* {{1},{2,0,2},{0,1,0},{2,0}} *)


5

x = {TCC12, TCC12, B96, TM12, TCC12, B96}; x /. {a___, b_, b_, c___} :> {a, b, c} {TCC12, B96, TM12, TCC12, B96} First /@ Split[x] Same output, but probably faster. Update thanks to Belisarius (m = {{1, 1, 1, 1}, {2, 2, 0, 2}, {0, 1, 0, 0}, {2, 2, 0, 0}}) // MatrixForm Map[First, Split /@ m, {2}] // MatrixForm


8

Grid directly supports such lines, called Dividers: m = augmentedMatrix[6]; g = Grid[m, Dividers -> {7 -> {Red, Dashed}}] All that remains is to incorporate the large ( ) brackets used by MatrixForm: MatrixForm[{{g}}] Another approach is to realize that both MatrixForm and Grid produce a GridBox expression: Shallow[ToBoxes @ MatrixForm[m], ...


6

SeedRandom@0; mat = RandomInteger[{0, 10}, {2, 3, 3}]; MatrixForm@List@Grid[List@(TableForm /@ mat), Dividers -> {2 -> Directive[Red, Dashed]}] Of course you can play with spacings: TableForm[#, TableSpacing -> {1, 1}] & /@ mat To go a bit further with Dividers: SeedRandom@0; mat = RandomInteger[{0, 10}, {10, 3, 3}]; ...


3

The OP's listParametricPlot3D constructs nonplanar quadrilaterals (Polygons) for a GraphicsComplex with Polygon[Flatten[ Table[{1 + i + xx j, 2 + i + xx j, 2 + i + xx (j + 1), 1 + i + xx (j + 1)}, {j, 0, yy - 2}, {i, 0, xx - 2}], 1]] where xx, yy are the dimensions of the tensor grid for the surface in the OP's data. One problem with nonplanar ...


10

Here's an approach without If or For. First a helper function: (* Thanks to Belisarius for the mrow& suggestion *) g[x_] := NestWhile[mrow&, x, MemberQ[x - #, 0] &] Then: NestList[g, mrow, 9] // MatrixPlot Where mrow is as you've defined it in the question.


1

row := Take[ NestWhile[Join[#, ConstantArray[RandomInteger[{0, 2}], RandomChoice[{2, 4, 6, 8}]]] &, {} , Length@# < 10 &], 10] Nest[Module[{b}, (While[Times @@ (#[[-1]] - (b = row)) == 0]; Append[#, b])] & , {row} , 9] // MatrixPlot


3

Nice question. I'd try to do something with recursion instead, like Clear[f]; f[n_] := f[n] = newRow[f[n - 1]] f[0] = ConstantArray[10, 10]; newRow[previousRow_] := With[{row = mrow}, If[MemberQ[previousRow - row, 0], newRow[previousRow], row] ] Array[f, 10] // MatrixPlot


5

Could look for a counterexample using FindInstance. tmat = {{t11^2, t11*t12}, {t11*t12, t12^2 + t22^2}} - IdentityMatrix[2]; evals = Eigenvalues[tmat]; FindInstance[(evals[[1]] <= 0 || evals[[2]] <= 0) && t11^2 >= 1 && t22^2 >= 1, Variables[tmat], Reals] (* Out[237]= {{t11 -> Sqrt[2], t12 -> 1, t22 -> ...


5

The eigenvalues are Eigenvalues[{{t11^2, t11*t12}, {t11*t12, t12^2 + t22^2}} - IdentityMatrix[2]] giving {1/2 (-2 + t11^2 + t12^2 + t22^2 - Sqrt[ t11^4 + 2 t11^2 t12^2 + t12^4 - 2 t11^2 t22^2 + 2 t12^2 t22^2 + t22^4]), 1/2 (-2 + t11^2 + t12^2 + t22^2 + Sqrt[ t11^4 + 2 t11^2 t12^2 + t12^4 - 2 t11^2 t22^2 + 2 t12^2 t22^2 + ...


4

I think the analogue of Matlab's implicit concatenation is ArrayFlatten, but it still needs to be called explicitly. (aa = Table[a[i, j], {i, 3}, {j, 3}]) // MatrixForm $$\left( \begin{array}{ccc} a(1,1) & a(1,2) & a(1,3) \\ a(2,1) & a(2,2) & a(2,3) \\ a(3,1) & a(3,2) & a(3,3) \\ \end{array} \right)$$ (bb = Table[{b[i]}, ...


2

You can use the option ZeroTest as follows: mat = {{c1 d1 - e1 f1, c1 d2 - e1 f2, c1 d3 - e1 f3, c1 d4 - e1 f4}, {c2 d1 - e2 f1, c2 d2 - e2 f2, c2 d3 - e2 f3, c2 d4 - e2 f4}, {c3 d1 - e3 f1, c3 d2 - e3 f2, c3 d3 - e3 f3, c3 d4 - e3 f4}, {c4 d1 - e4 f1, c4 d2 - e4 f2, c4 d3 - e4 f3, c4 d4 - e4 f4}, {c5 d1 - e5 f1, c5 d2 - e5 f2, ...


1

Sure, e.g.: TR[DiracMatrix[mu,nu,rho,si,rho,nu,mu,si, Dimension -> n]] gives -4*(-2 + n)^3*n


3

A simpler approach: {m, n} = Dimensions[xx]; fx = Interpolation[Flatten[Table[{{i, j}, xx[[i, j]]}, {i, m}, {j, n}], 1]]; fy = Interpolation[Flatten[Table[{{i, j}, yy[[i, j]]}, {i, m}, {j, n}], 1]]; fz = Interpolation[Flatten[Table[{{i, j}, zz[[i, j]]}, {i, m}, {j, n}], 1]]; ParametricPlot3D[{fx[i, j], fy[i, j], fz[i, j]}, {i, 1, m}, {j, 1, n}, PlotPoints ...


5

(Updated to show no mesh.) The data seems to have been converted from polar coordinates. One can convert it back and interpolate, with an appropriate interpolation order. Below I show orders 1 and 3 (3 is the default). polardata = {{#4, #3}, Norm[{#1, #2}]} & @@@ Transpose[{ Flatten[xx], Flatten[yy], Flatten[zz], Flatten@ ...


2

Here's a Manipulate that applies any affine transformation to an image. The 2-by-2 matrix transformation is in the upper 2-by-2 block of the affine function and the {b1,b2} parameters shift the image left-right and up-down. img = Import["http://i.stack.imgur.com/pp27n.png"]; Manipulate[ GraphicsRow[{AffineTransform[{{{a11, a12}, {a21, a22}}, {b1, b2}}], ...


0

Replace the second line by r[k_] := -I Sort[I Eigenvalues[f[k]]][[3]]; And life is good.


0

Just use Chop to get rid of small and spurious quantities: f[k_] = {{0.001 - 2 I k + 0.001 k^2, -0.001, 0.001, -0.001}, {-1, 0.5 - I k + 0.001 k^2, 0.501, -0.001}, {0.001, -0.001, 0.001 + 2 I k + 0.001 k^2, -0.001}, {0.501, -0.001, -1, 0.5 + I k + 0.001 k^2}}; r[k_] = Eigenvalues[f[k]][[3]] // Chop; Plot[{Re[r[k]],Im[r[k]]}, {k, -1, 1}] (* ...


2

f[k_] = Rationalize@{{0.001 - 2 I k + 0.001 k^2, -0.001, 0.001, -0.001}, {-1, 0.5 - I k + 0.001 k^2, 0.501, -0.001}, {0.001, -0.001, 0.001 + 2 I k + 0.001 k^2, -0.001}, {0.501, -0.001, -1, 0.5 + I k + 0.001 k^2}}; r[k_] = Eigenvalues[f[k], Cubics -> True, Quartics -> True][[3]]; p1 = Plot[Im[r[k]], {k, -1, 1}, WorkingPrecision -> 30, ...


9

You did not specify if this test should be optimized for the positive or negative case. If most of your matrices will fail the test it can be greatly beneficial to have an early exit behavior. For example if the lower left element in the matrix is not zero you can fail the matrix after a single element test! And even in the positive case the elements on ...


11

Maybe upperTriangularMatrixQ2[mat_?MatrixQ] /; Equal @@ Dimensions@mat := UpperTriangularize@mat == mat; test = RandomInteger[{1, 100}, {1000, 1000}]; upperTriangularMatrixQ@test // AbsoluteTiming {2.126050, False} upperTriangularMatrixQ2@test // AbsoluteTiming {0.003277, False} test2 = UpperTriangularize@test; upperTriangularMatrixQ@test2 ...


3

You can also use Dot: sundat.{{2., 0}, {0, .5}} (* {{560., 0.041}, {561., 0.0495}, {7990., 0.00435}, {8000., 0.00434}} *)


14

A simple solution with And, Xor and Mod: n = 41; Table[If[Abs[2 j - 1 - n] < i && Xor[Mod[Abs[2 j - 2 - n] - i, 3] == 0, 2 j > n + 1], 1, 0], {i, n}, {j, n}] // ArrayPlot The same for n = 333: To be more functional-style: j = ConstantArray[Range@n, n]; i = Transpose@j; UnitStep[i - 1 - Abs[2 j - 1 - n]] (1 + (1 - 2 ...


6

The closest I get is this MatrixPlot@ Table[Boole@((Divisible[Abs[k - n], 3] || k >= 22) && (Divisible[Abs[-22 + k + n], 3] \[Implies] k < 22) && n > 2 Abs[-22 + k]), {n, 41}, {k, 41}]


10

If you were to allow CellularAutomaton I think the simplest change is to drop every other row and column: MatrixPlot[CellularAutomaton[57, {{1}, 0}, 80][[;; ;; 2, ;; ;; 2]], ImageSize -> 400, Mesh -> All, PlotTheme -> "Monochrome"] There is however a discontinuity in the center compared to your original. I'll start working on other options. ...


1

Although I prefer kguler's double Transpose you could also use Inner: sundat = {{280., 0.082}, {280.5, 0.099}, {3995., 0.0087}, {4000., 0.00868}}; Inner[Times, sundat, {2., .5}, List] {{560., 0.041}, {561., 0.0495}, {7990., 0.00435}, {8000., 0.00434}} Or leveraging Simon's solution from: How can I make threading more flexible? smartThread[sundat ...


4

sundat = {{280., 0.082}, {280.5, 0.099}, {3995., 0.0087}, {4000., 0.00868}}; conversionfactors = {2., .5}; data2 = Transpose[conversionfactors Transpose[sundat]] or data2 = conversionfactors # & /@ sundat both give (* {{560.,0.041},{561.,0.0495},{7990.,0.00435},{8000.,0.00434}} *)


5

Here is my expanded response to kguler. I noticed that usually Band is less effective then DiagonalMatrix@SparseArray or manual constructing of the resulting SparseArray f1 = SparseArray[Inner[Rule, {Band[{1, 2}], Band[{1, 1}], Band[{2, 1}]}, #, List]] &; f2 = Inner[DiagonalMatrix, #, {1, 0, -1}] &;; f3 = Inner[DiagonalMatrix[SparseArray@#, #2] ...


0

Let me join this old thread. One can set the default element to 1. and inverse the array as you want HoldPattern@setDef[SparseArray@s___, x_] := SparseArray[#, #2, x, #4] &@s; V == DiagonalMatrix[1/setDef[Diagonal[A], 1.]] (* True *) Timings: Do[DiagonalMatrix@SparseArray[1/Normal[Diagonal[A]]], {1000}] // AbsoluteTiming (* {12.273275, Null} *) ...


7

As Gregory Rut mentioned, DiagonalMatrix already has built-in support for generating banded matrices from lists: Inner[DiagonalMatrix, RandomInteger[{0, 5}, #] & /@ {49, 50, 49}, {-1, 0, 1}] which yields the following (when ArrayPlot is applied):


7

diag = RandomChoice[CharacterRange["a", "z"], #] & /@ {49, 50, 49}; m = SparseArray[Inner[Rule, {Band[{1, 2}], Band[{1, 1}], Band[{2, 1}]}, diag, List]] MatrixPlot[m, Mesh -> True] Timings: for a 50X50 matrix the timings of two methods based on Band and DiagonalMatrix are both 0. For larger matrices, Band is much faster: ClearAll[f1, f2]; f1 = ...


6

You have to be a bit careful here; your last approach does not give the desired matrix F: (LinearSolve[dV, dv] // Transpose).dV === dv False Then what does give the correct output? We can use the fact that for generic matrices $A$ and $B$ we have $A.B = (B^T.A^T)^T$ and write F = Transpose @ LinearSolve[Transpose @ dV, Transpose @ dv] And indeed, ...


7

Short Version You can get Mathematica to convert WolframAlpha-style free-form input into a valid expression using CTRL+= or by starting an input expression with =: Note how Mathematica made sense of two alternative free-form expressions of the same thing, and converted each into the same valid expression involving the Dot operator. Longer Version: ...


4

Dot is a special case of Inner list = {{0, 1}, {0, 2}, {0, 3}}; Inner[Times, list, Transpose[list], Plus] // MatrixForm list = {{1, 1}, {1, 2}, {1, 3}} Inner[Power, list, Transpose[list], Plus] // MatrixForm Also possible: Outer[Times, {1, 2, 3}, {1, 2, 3}] // MatrixForm



Top 50 recent answers are included