Tag Info

Hot answers tagged

26

As I expressed in my comment above, it is possible (and easy) to use the image processing functions for this. Taking m to be the matrix above the following steps illustrate the idea: img = Image@m; ComponentMeasurements[img, "PerimeterCount"] (* {1 -> 3, 2 -> 27, 3 -> 9, 4 -> 6, 5 -> 15, 6 -> 3, 7 -> 6, 8 -> 3, 9 -> 3, 10 -> 3, ...


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]


20

matOP = {{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 1, 0}, {0, 0, 1, 0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}}; $\left( \begin{array}{cccccccc} 0 & 1 & 0 & 0 & 1 & 0 & 1 & 0 \\ 0 & 1 & 0 & 0 & 1 & 0 & 1 & 0 \\ 0 & 0 & 1 ...


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

Here is a Graph-based solution inspired by this Q&A where mat is your given matrix. binaryGraph[mat_] := Module[{pos, edge, dedge}, pos = Position[mat, 1]; edge = Select[Subsets[Range@Length@pos, {2}], Last@# - First@# <= (Max@Dimensions@mat + 1) &]; dedge = DeleteDuplicates[UndirectedEdge @@@ (Extract[edge, #] & /@ ...


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 my take using NestList cm[n_] := NestList[# + 1 &, Join[Range[n/2 + 1], Reverse@Range[n/2]], n - 1] Then cm[11] Here's a FoldList version (just as fast): cmf[n_] := FoldList[#1 + #2 &, Join[Range[n/2 + 1], Reverse@Range[n/2]], ConstantArray[1, n - 1]] The above methods according to the benchmarks posted are already as ...


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


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


14

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}


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


11

mtrx = {{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 1, 0}, {0, 0, 1, 0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}}; Once we re-number the elements of mtrx using a function like renumber = Module[{i = 1}, # /. 1 :> i++] &; (* thanks: Mr.W *) mtrx2 =renumber@mtrx ...


11

Assuming m is the test matrix; the following is a graph based solution: nbours[x_, y_] := Module[{xr, yr, nts}, xr = Select[{x - 1, x, x + 1}, # >= 1 && # <= Length@m &]; yr = Select[{y - 1, y, y + 1}, # >= 1 && # <= Length@m &]; nts = Cases[ Table[{xrp, y}, {xrp, xr}]~Join~Table[{x, yrp}, {yrp, yr}], ...


11

This is pretty straightforward and very easy to follow even for someone who just started learning Mathematica. This has its value when you need to read your code a year later, even if you're an experienced user. n = 11; k = (n + 1)/2; row = k - Abs[k - Range[n]]; Table[row + i, {i, 0, n - 1}] Should be fast enough for most application. Benchmarks The ...


11

Edit: See end of post for latest performance enhancement. f=With[{c = Ceiling[#/2]}, c - 1 + Array[#1 - Abs[c - #2] &, {#, #}]] &; f[5] (* {{1, 2, 3, 2, 1}, {2, 3, 4, 3, 2}, {3, 4, 5, 4, 3}, {4, 5, 6, 5, 4}, {5, 6, 7, 6, 5}} *) Short, sweet, fast. For more speed, f5 = With[{c = Ceiling[#/2]}, Subtract[ ArrayPad[ConstantArray[Range[#, # ...


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

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


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] & /@ ...



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