Tag Info

Hot answers tagged

24

If you have Mathematica 10 you can use the new Inactive functionality step1 = MatrixForm[Inner[Inactive[Times], A, A, Inactive[Plus]], TableSpacing -> {3, 3}] step2 = Activate[step1, Times] Activate[step2]


19

I think the built-in function ArrayComponents is what you need: vec = {1, 4, 4, 8, 7, 7, 4}; ArrayComponents[vec] (* {1,2,2,3,4,4,2} *) mat = {{1, 4}, {2, 7}, {7, 2}, {9, 4}}; ArrayComponents[mat] (* {{1,2},{3,4},{4,3},{5,2}} *) raggedarray = RandomSample /@ (CharacterRange["a", "z"][[#]] & /@ Range[RandomSample[Range[5]]]) (* ...


17

You can do: x[[2 ;; -2, 2 ;; -2]] = 0; x or ReplacePart[x, {i, j} -> 0 /; And @@ MapThread[Less, {{1, 1}, {i, j}, Dimensions@x}]]


16

Here's an edited version of my answer to a related question (elsewhere). Since your central question was about speed (or time complexity), you might wish to know an important result from elementary theory of algorithms and computational complexity, which is that the time and space complexity of matrix multiplication depends upon the order of such ...


15

This bug has been fixed in V10 mat = {{7/2 - I/2, -1 + I, 1/2 + 5 I/2}, {-1 + I, 5 + I, -1 + I}, {1/2 + 5 I/2, -1 + I, 7/2 - I/2}}; Eigensystem[mat] Gives: {{6, 3 + 3 I, 3 - 3 I}, {{1, -2, 1}, {1, 1, 1}, {-1, 0, 1}}} \begin{array}{ccc} 6 & 3+3 i & 3-3 i \\ \{1,-2,1\} & \left\{1,1,1\right\} & \{-1,0,1\} \\ \end{array}


15

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 ...


15

This happens because of unpacking when the numbers exceed $MaxMachineNumber: fast = Dot @@@ Partition[tab, Divisors[3960][[42]]]; Developer`PackedArrayQ /@ fast (* {True, True, True, True, True, True, True, True} *) Max[fast] <= $MaxMachineNumber (* True *) slow = Dot @@@ Partition[tab, Divisors[3960][[43]]]; Developer`PackedArrayQ /@ slow (* {False, ...


13

You can use HoldForm or Defer with Composition if you are still using Pre V10 versions: MatrixForm[Inner[Composition[Defer, Times], A, A, Composition[Defer, Plus]], TableSpacing -> {3, 3}] MatrixForm[Inner[Times, A, A, Composition[HoldForm, Plus]], TableSpacing -> {3, 3}] MatrixForm[Inner[Times, A, A, Plus], ...


13

For readers who didn't read all the comments, the slowdown is due to a lack of packing of tb, whereas RandomReal returns packed arrays when more than 250 elements are generated. The reason why packing tb fails is because some elements have different precision than others, and (I think?) ToPackedArray requires arrays to be of homogeneous type. To fix this, ...


12

Using Composition I can apply RotationTransform, TranslationTransform , ShearingTransform one after the other. Graphics3D[{ Opacity[1] , Red , Arrow[{{0, 0, 0}, {1, 0, 0}}] , Green , Arrow[{{0, 0, 0}, {0, 1, 0}}] , Blue , Arrow[{{0, 0, 0}, {0, 0, 1}}] , Opacity[0.2] , GeometricTransformation[Cuboid[-{1, 1, 1}/4, {1, 1, 1}/4], ...


12

This seems fast(er): Extract[a, Transpose[{v, Range@Length@v}]] Addendum Mr.Wizard's clean method Diagonal @ a[[v]] has a surprising property for those of us who think that packed arrays rank just below the wheel in the list of inventions for the sake of efficiency. For unpacked arrays a, it uses virtually no extra memory. Example Initialization. ...


12

The old-school way to do this: index[a_] := Module[{i = 1, f}, f[x_] := f[x] = i++; f /@ a] index @ vec {1, 2, 2, 3, 4, 4, 2} A method using Assocation, introduced long after ArrayComponents. index2[a_List] := AssociationThread[#, Range@Length@#] ~Lookup~ a & @ DeleteDuplicates @ a Edit #2: extended to matrices using eldo's own method: ...


12

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 ...


12

Translated Cleve Moler's magic() function from Matlab code to Mathematica. Grid[Partition[MatrixForm@magic[#] & /@ {3, 4, 5, 6, 7, 8, 9, 10}, 4], Frame -> All, FrameStyle -> LightGray] code: magic[n_Integer /; (n > 0 && n != 2)] := Module[{m, j, k, p, i}, (*Translation of Cleve Moler's magic magic() function to ...


12

@Nasser's answer is nice, but slowly when Mod[n,4]==0. Here is a faster code, efficiency is close to Matlab : ClearAll[magic] magic[n_?OddQ] := oddOrderMagicSquare[n]; magic[n_ /; n~Mod~4 == 0] := Module[{J, K1, M}, J = Floor[(Range[n]~Mod~4)/2.0]; K1 = Abs@Outer[Plus, J, -J]~BitXor~1; M = Outer[Plus, Range[1, n^2, n], Range[0, n - 1]]; M ...


11

Just another alternative. x - ArrayPad[ArrayPad[x, -1], 1] // MatrixForm


11

Assuming that the values of your matrix are all distinct, or that you don't count repetitions in n, you can do this: ClearAll[largest]; largest[mat_, n_] := Clip[mat,{RankedMax[#, n], Max[#]}, {0, 0}] &[Flatten@mat] So that large = RandomReal[{1, 10}, {50, 50}]; Do[largest[large, 50], {1000}]; // Timing // First (* 0.076633 *)


11

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. ...


11

A straightforward and clear solution: f[m_] := Flatten@Table[m[[j, i - j + 1]], {i, Length@m}, {j, i}] f@{{1, 2, 3}, {4, 5, 6}, {7, 8, 9}} (* {1, 2, 4, 3, 5, 7} *) A fast compiled version: fc = Compile[{{m, _Integer, 2}}, Module[{n = Length@m, res, k = 0}, res = Array[0 &, Quotient[n (n + 1), 2]]; Do[res[[++k]] = m[[j, i - j + 1]], {i, ...


11

It turns out ListSurfacePlot3D does a terribly poor job of approximating the surface in the OP, otherwise one will just apply DiscretizeGraphics to the output obtained from ListSurfacePlot3D and be done with it. But since that's not applicable here, we present an approach that uses alpha shapes to approximate the shape of the given point set by tuning a ...


10

The following should work: lis = {{1, 2, 3, 4, 5, 6}, {1, 9, , 4, 6, 2}, {4, a, 3, 7, 1, 2}, {3.4, 5.2, 6.5, 7.7, 6.1, 2}}; Then: Cases[lis, {__?NumericQ}] {{1, 2, 3, 4, 5, 6}, {3.4, 5.2, 6.5, 7.7, 6.1, 2}} We can also use VectorQ with Select Select[lis, VectorQ[#, NumericQ] &] If you have Version 10, the following works: ...


10

At least internally, the following is a nice recursive way of thinking about the chess board: MatrixPlot[CellularAutomaton[250, {0, 1}, {7, 7}]] Not sure if this is what was meant by functional style. It's hard to make a one-liner functional. To address extensibility: the dimensions of the board are directly dictated by the argument {7,7}, and the ...


10

It's an issue of growth of term size in this example. If you do the straight iteration then at each step the matrix elements roughly quadruple in size (because each time you multiply every element by a variable, and sum four such products per matrix entry). We confirm this below on an example of half the size. tab = Partition[#, 4] & /@ ...


10

The definition of the scalar product in your question assumes that all your kets are orthogonal unit vectors. In that case, the most natural approach would be to use the built-in Bra and Ket as follows: Ket /: Dot[Bra[x__], Ket[y__]] := Times @@ MapThread[KroneckerDelta, {{x}, {y}}] BraKet[x_, y_] := Bra[x].Ket[y] Bra[2, 4].Ket[2, 4] (* ==> 1 *) ...


10

This is really a natural fit for Outer: t = Table[{i, j}, {i, 1, 2}, {j, 1, 2}]; Outer[Apply, {Plus, Subtract, Times, Divide}, t, 2] (* ==> {{{2, 3}, {3, 4}}, {{0, -1}, {1, 0}}, {{1, 2}, {2, 4}}, {{1, 1/2}, {2, 1}}} *)


9

For the filling pattern you showed: x = {a1, a2, a3, a4, a5, a6}; n = 3; x ~Internal`PartitionRagged~ Range[n, 1, -1] ~Flatten~ {2} // PadLeft {{a1, a4, a6}, {0, a2, a5}, {0, 0, a3}} To find n given a complete input list x you can use: n = Sqrt[1 + 8 Length@x]/2 - 1/2


9

I can't test the timing right now, but maybe it's worth mentioning Threshold[large, {"LargestValues", 50}]


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 ...


9

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.


9

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], ...



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