Tag Info

Hot answers tagged

25

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


22

Clip is usually quite fast: m = RandomReal[{-10^6, 10^6}, {3, 3}]; neg = Clip[m, {-Infinity, 0}] pos = Clip[m, {0, Infinity}] (*{{0., -181286., -442666.}, {0., -233694., -847828.}, {-128249., 0., -540037.}} {{947792., 0., 0.}, {755278., 0., 0.}, {0., 63058.1, 0.}}*) neg + pos == m True


18

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

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


16

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


15

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


13

You could also use the functions Positive and Negative: m = RandomInteger[{-10, 10}, {10, 10}]; pos = m Boole[Positive[m]]; neg = m Boole[Negative[m]]; give the positive and negative portions. As becko points out, replacing Boole[Positive[mat]] with UnitStep[m]: pos = m UnitStep[m]; neg = m UnitStep[-m]; is even more succinct. These can even be ...


12

Using Replace (assuming you only want to replace on level 2, as you mention "matrix"): Using Except My first version (I kept this version to point out the usage/impact of Orderless) Replace[SIGMA, Except[HoldPattern[___ x^2 ___]] -> 0, {2}] {{0, b x^2}, {0, 0}} Improved version, thanks to Leonid Replace[SIGMA, Except[___ x^2] -> 0, {2}] as ...


11

m + 1 - Unitize[m] might be faster because it preserves packed arrays, but we'd need a real test.


11

Let me put my comment into an answer, because I think we might have misunderstood each other. You answered in the comment However, it would be great to do whole process (preparation of the matrix, solving the eigensystem, and further analysis) in Mathematica. That exactly was my idea. You only write some lines of C-Code which are compiled into a ...


11

Looking at CompilePrint[compiledGlynnAlgorithm] there are some CopyTensor in it which aren't really needed. There's also a few CoerceTensor in there when it might be faster to just coerce the integer matrix once at the beginning. By slightly adjusting the function all CopyTensor and CoerceTensor go away giving a small increase in speed: ...


11

Since Mathematica offers powerful symbolic capabilities I find that more effective solution to the problem uses exact numbers instead of machine precission ones and consequently exploits appropriate symbolic functions. The given matrix m: m = {{0.04 - 0.4 b, 0, 0.04 - 0.4 b}, {0, -0.08 - 1.2 b, -0.06 - 0.9 b}, {1.04 - 0.4 b, 2.08 - 0.8 b, 0}}; ...


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

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


11

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


10

l = {x + 2 y, 3 x - y}; Normal@CoefficientArrays[l, {x, y}][[2]] {{1, 2}, {3, -1}}


10

Computing the eigenvalues is actually overkill. It could be done by row reduction. For convenience, I set empty list to be positive semidefinite. psdcheck[m_]:=( If[Length@m== 0,Return@True]; If[Length@m== 1,Return@If[Negative@m[[1,1]],False,True]]; If[Or@@(Negative@Diagonal@m),Return@False]; Module[{mtemp,ind1}, ...


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

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 *)


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

This is in fact tricky. But j is not what it looks. TensorRank[i] gives 2 and its dimensions are {3,1}. j is different: TensorRank[j] gives 1 and its dimensions are {3} instead of {3,1}. A fix. j = {{1,2,3}} and you get i.j {{1, 2, 3}, {2, 4, 6}, {3, 6, 9}} j.i gives {{14}}. The reason it apparently works with j.i is that in this case ...


9

Here is a simple method that seems to be somewhat faster than yours on unpackable data: colDrop[array_, drop_] := Module[{m = array}, m[[All, drop]] = Sequence[]; m] Test: data = Range /@ RandomInteger[{15, 50}, 500000]; data = Map[FromCharacterCode, data + 37, {2}]; colDropper[data, {1, 3, 5, 8, 10, 11}] // Timing // First colDrop[data, {1, 3, 5, 8, ...


9

OK, encouraged by belisarius, here's the way. If you know that Reverse exists you may use: Reverse /@ Reverse @ m then you could check the docs and realise that Reverse has 2nd argument: Reverse[m, {1, 2}] But if you don't but you are amazed by Span+Part you can end up with: m[[;; , {4, 3, 2, 1}]][[{4, 3, 2, 1}]] or even more Span: :) m[[;; , -1 ...


9

This should be pretty efficient (still generates a few extra elements, but I'd venture the overhead of short-circuiting that would exceed the overhead of the trimming): y = 14; m = 7; array=Take[Flatten[ConstantArray[#, Ceiling[(y - m)/Length@#]]], y - m] & /@ Table[Join[ConstantArray[1/row, row], ConstantArray[0, row]], {row, 1, m}]; ...


9

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


9

Using a slightly modified version this answer in a related Q/A: ClearAll[m, edges, v, vcs, g, cc, ap, ap2, pos]; m = Module[{i = 1}, mat /. 1 :> i++] (* where `mat` is the input matrix *); v = ComponentMeasurements[m, "Label"][[All, 1]]; vcs = ComponentMeasurements[m, "Centroid"]; edges = UndirectedEdge @@@ DeleteDuplicates[ Sort /@ Flatten[ ...



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