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]]]) (* ...


16

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


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

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


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


13

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


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

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

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

This is almost certainly an out-of-memory crash. The underlying issue is that the OS X front-end is a 32-bit program, so has a process memory limit of around 2 GB. It is normal for an attempted allocation beyond that limit to lead to a crash. A similar size ArrayPlot example I tried on my Windows machine (where the front-end is 64-bit) used more than 3 GB ...


10

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


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

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


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

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

While the documentation does not specifically say that symbolic Hermitian matrices are not necessarily given orthonormal eigenbases, it does say For approximate numerical matrices m, the eigenvectors are normalized. For exact or symbolic matrices m, the eigenvectors are not normalized. From this, it's reasonable to guess that if Mathematica isn't ...


9

Note: the answer below referred to a previous version of the question You may have more success with SparseArray. For instance: SparseArray[ {{i_, i_} -> 1, {i_, j_} /; Abs[i - j] == 1 -> 2}, {20000, 20000}, 0 ]; // RepeatedTiming (* Out: {0.21, Null} *) You would use patterns to assign values to positions within the matrix determined ...


9

Now fixed in version 10.2. In[1]:= m = {{0, 1}, {-1, 0}}; In[2]:= {AntihermitianMatrixQ[m], HermitianMatrixQ[m], AntihermitianMatrixQ[m]} Out[2]= {True, False, True} As per the comments, yes, there is information stored in the internal representation of matrices (for example, a symmetry flag) and no, it is not accessible from top level code.



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