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


21

There is an appropriate metrics: HammingDistance[ab, ac] 1 one could use also (but in general it yields different results since it counts transpositions, deletions etc.) DamerauLevenshteinDistance[ab, ac] 1


21

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


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

For Integer data we also could write: Tr @ Unitize @ BitXor[ab, ac] 1 For Real data we can use the slightly slower but also shorter: Tr @ Unitize[ab - ac] Blackbird challenged me to provide a method that works on all input types. My approach is to select between methods depending on data. diff[a__?(VectorQ[#, IntegerQ] &)] := Tr @ Unitize ...


14

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

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


10

This appears to be a genuine bug with exact arithmetic in Eigensystem. Here is a comparison to the same calculation with real numbers, for which I use the matrix mat//N: 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}}; {vals, vecs} = Eigensystem[mat] (* ==> {{6, 3 + 3 I, 3 - 3 I}, {{1, -2, 1}, ...


10

Why complicate it? a[[3 ;; 4, 2 ;; 4]] = b; Here is a general function. It take a main matrix, and a sub matrix. It puts the sub matrix inside the main matrix. All what you have to do is just tell it the starting row number and starting column number for where to insert the sub matrix at. Updated: Added pattern checking on arguments. Added additional ...


10

You can also achieve your ultimate (or ulterior) goal with ImageResize: imgdata = Array[0.2 #1 + 0.1 #2 - 0.2 + 0.01 #3 &, {2, 2, 3}] (* {{{0.11, 0.12, 0.13}, {0.21, 0.22, 0.23}}, {{0.31, 0.32, 0.33}, {0.41, 0.42, 0.43}}} *) img = Image @ imgdata; img2 = ImageResize[img, Scaled[2]]; ImageData[img2] // MatrixForm P.S. There are various Resampling ...


10

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


10

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


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


9

Based on the comments, Listable is a possible way for you. Thus, you could: SetAttributes[f,Listable] and then simply: f[m1,m2] to obtain: {{f[a1, a2], f[b1, b2]}, {f[c1, c2], f[d1, d2]}} EDIT To apply this on a built-in (non-Listable function) like List on could do, as noted by @rcollyer below: f[m1,m2]/.f->List (please also note his ...


9

You could do this ab = {1, -1, -1, -1, 1, 1}; ac = {1, -1, -1, 1, 1, 1}; EditDistance[ab, ac] which would give a result even if the lists had different lengths (or whatever). The documentation says: EditDistance[u, v] gives the number of one-element deletions, insertions, and substitutions required to transform u to v.


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