Tag Info

New answers tagged

1

You could do it with a sparse array: s = SparseArray[ MapThread[({#1, #2} -> 1) &, { Range[Length[v]], (v - 1)*Length[v] + Range[Length[v]] }], {Length[v], Times @@ Dimensions[a]}]; s.Flatten[a, 1] But sadly, Flatten will take a long time for large a. (If you could keep around Flatten[a] for many "queries", it might be ...


1

This could be fast. a[[v[[#]], #]] & /@ Range[Length@v];


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


4

Edit: please see Update below. Although I am self-answering, as stated, I am not satisfied with these approaches. Nevertheless they may be useful and they can serve as a benchmark for any new solutions. This is cleanest method I know, though sadly it is a true memory hog, and not fast either: Diagonal @ a[[v]] {100, 200, 30, 4, 5, 600, 7} More ...


1

The iteration can be performed as follows: A[t_] = {{t, 0}, {Cos[t], 1}}; B[t_] = {{Exp[t], 0}, {0, Exp[-t]}}; T[F_] := Expand[A[t] + Integrate[B[s].F /. t -> s, {s, 0, t}]]; iteration = NestList[T, {{t, 0}, {0, t}}, 7]; Column[Framed /@ MatrixForm /@ iteration[[1 ;; 3]]] Well, it's not immediately clear what the limits are, as it was over in this ...


3

a = {{3, 0, -1}, {-5, 2, 4}, {-2, -6, 3}}; b = {{1, 2}, {-3, 4}, {2, 1}}; grdF = Grid[#1, Dividers -> {#2, #3}] &; ga = grdF[a, {3 -> Red}, {3 -> Red}]; gb = grdF[b, False, {3 -> Red}]; gab = grdF[ga[[1]].gb[[1]],First[Dividers /. Options[gb]], Last[ Dividers /. Options[ga]]]; Row[{ga, "\[Times]", gb, " = ", gab}, Spacer[3]] Update: ...


0

You can also use PositionIndex in Version 10 (PositionIndex /@ ZeroCrossings)[[All, 2]] Gives: {{3, 9}, {4, 5, 8, 12, 13}, {4, 12, 13}, {4, 8, 11, 13}, {4, 9, 12, 13}, {5, 6, 11}}


0

Another approach: ZeroCrossings = {{0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0}}; Map[Last, ...


1

Primarily you just need to use Table instead of Do and Print. Also you can simplify the code: Table[Flatten @ Position[t, 1], {t, ZeroCrossings}] {{3, 9}, {4, 5, 8, 12, 13}, {4, 12, 13}, {4, 8, 11, 13}, {4, 9, 12, 13}, {5, 6, 11}} See Case #2 of: Alternatives to procedural loops and iterating over lists in Mathematica It may be simpler to use Map: ...


2

Perhaps your systerm is timing out. $Version "10.0 for Mac OS X x86 (64-bit) (June 29, 2014)" mat = ({{0, Sin[x + y], Sin[z + y], Sin[x + z]}, {Sin[x + y], 0, Sin[x - z], Sin[z - y]}, {Sin[z + y], Sin[x - z], 0, Sin[y - x]}, {Sin[x + z], Sin[z - y], Sin[y - x], 0}}); eval = Eigenvalues[mat] // Simplify; Length[eval] 4 eval /. {x ...


2

I shall not attempt to replicate the exact function of your code but rather to address the problem posed in text of your Question. As a starting point I suggest you build a Dispatch table of the replacements you wish to make and then apply it with Replace. First some sample data: SeedRandom[0] m = RandomInteger[66, {1024, 1024}]; keep = Array[Prime, 18]; ...


2

As you note Binarize does just this: Binarize[image,t] creates a binary image by replacing all values above t with 1 and others with 0. Therefore you merely need to convert your data into an Image. First some test data: m = Array[Plus, {21, 21}, -10]; m // MatrixPlot Now we convert to an Image: img = Image[m] Do not worry that the data ...


4

Clip seems perfectly suited: mat = RandomReal[{0, 10}, {100, 100}]; Manipulate[ MatrixPlot[Clip[mat, {threshold, threshold}, {0, 1}]], {threshold, 0, 10} ] Here we use the form of Clip with three arguments: Clip[mat, {threshold, threshold}, {0, 1}] It takes everything below threshold and sets it to 0, and takes everything above threshold and sets ...


2

SelectComponents is pretty fast but it labels the background with 0, not 100. You might be able to work with that. SelectComponents[mat, "Label", MemberQ[keep, #] &] but this is a bit faster: sel = Compile[{{label, _Integer}, {keep, _Integer, 1}}, If[MemberQ[keep, label], label, 0], (* or 100 if necessary *) RuntimeAttributes -> {Listable}, ...


3

In order to apply a function to every element we can use Map with the level specification: Map[If[MemberQ[keep, #], #, 100] &, matrix, {2}] Another option using the Listable attribute: Function[{x}, If[MemberQ[keep, x], x, 100], Listable]@matrix; This turned out to be a lot slower though. I ran these on Michael E2's test case and the Listable ...


5

The term incidence matrix has caused confusion on this site before, so I think it's time to clear this up. There's no standard, generally agreed upon definition of incidence matrix. It's a loose term for a matrix that describes the relationship (connections) between two different classes of objects. What these objects are can vary. When you see the term ...


4

The answer why it is not valid incidence matrix is given by the above answers. To verify if your matrix is valid, use the following command m = {{1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1}, {0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0}, {0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 0, ...


4

The test matrices are matrices but not incidence matrices. The rows represent the vertices and each column represents an edge. Consequently each column must have only 2 non-zero entries or a single entry of 2 for self loops. This is not the case for any of the matrices or their transposes. To check for yourself, try yourself, e.g.: mat = ...


4

Sorry, but your matrices aren't valid incidence matrices. From the IncidenceMatrix help page: For an undirected graph, an entry $a_{ij}$ of the incidence matrix is given by: 0 if vertex $v_i$ is not incident to edge $e_j$ 1 if vertex $v_i$ is incident to edge $e_j$ 2 if vertex $v_i$ is incident to edge $e_j$ and a self-loop In ...


6

The compatibility information at Compatibility/tutorial/LinearAlgebra/MatrixManipulation says These functions were available in previous versions of Mathematica and are now available on the web at library.wolfram.com/infocenter/MathSource/6770: LinearEquationsToMatrices InverseMatrixNorm ConditionNumber You can download the original package ...


4

The LinearAlgebra package has been deprecated since Mathematica 5, and is no longer bundled with Mathematica 9 or newer. You can still download a part of it (which contains the MatrixConditionNumber function) at the URL that jtbandes gave in his answer. First, we need to load the package: (* Be sure to install the above linked package in a "LinearAlgebra" ...


4

This is another approach: pairRiffle[n_?EvenQ] := Riffle[#, #] & /@ (Permutations[Range@n, {n/2}]) pairRiffle[4] (* {{1, 1, 2, 2}, {1, 1, 3, 3}, {1, 1, 4, 4}, {2, 2, 1, 1}, {2, 2, 3, 3}, {2, 2, 4, 4}, {3, 3, 1, 1}, {3, 3, 2, 2}, {3, 3, 4, 4}, {4, 4, 1, 1}, {4, 4, 2, 2}, {4, 4, 3, 3}} *) Edit: in fact I could do without the Riffle and just use ...


5

This should do the job: AllPairs[n_?EvenQ] := Flatten[Permutations /@ Subsets[Range[n], {n/2}], 1] /. x_Integer :> Sequence[x, x] AllPairs[4] { {1, 1, 2, 2}, {2, 2, 1, 1}, {1, 1, 3, 3}, {3, 3, 1, 1}, {1, 1, 4, 4}, {4, 4, 1, 1}, {2, 2, 3, 3}, {3, 3, 2, 2}, {2, 2, 4, 4}, {4, 4, 2, 2}, {3, 3, 4, 4}, {4, 4, 3, 3} }


2

For any square matrix M which is the sum of two similar matrices M = A + B the determinant can be written as a sum of determinants as follows (example for two dimensions): det(M) = det( ( A11 + B11, A12 + B12), (A21 + B21, A22 + B22) ) = det( ( A11 + 0, A12 + 0), (A21 + B21, A22 + B22) ) + det( ( 0 + B11, 0 + B12), (A21 + B21, A22 + B22) ) and, ...


0

May be something like this also will help: dig[x_, y_, n_] := SparseArray[{Band[{x, y} - (Min[x, y] - 1)] -> 1}, {n, n}] // MatrixForm dig[3,2,5]


2

(rw = Join[ Prepend[ Array[StringForm["`1`(`2`,`3`)", "row", Sequence @@ (ToString /@ {##})] &, {9, 3}], Array[StringForm["`1`(`2`)", "corner", Sequence @@ (ToString /@ {##})] &, {3}]], Prepend[ Array[StringForm["`1`(`2`,`3`)", "data",Sequence @@ (ToString /@ {##})] &, {9, 7}], ...


0

How does this work for your matrix? colNames = Rest@First@rw rowNames = Rest[First /@ rw] cornerName = First@First@rw data = Rest[Rest /@ rw] It's a bunch of variations on First, Rest, and Map. EDIT: I misunderstood the question. Here's a more general matrix splitter, which divides it into four parts. The divisions are made after rowSplit and ...


0

n = 10; board = ConstantArray[0, {n, n}]; diag1[x0_, y0_] := Module[{x = x0, y = y0, satis}, satis = Select[ Plus[{x, y}, #] & /@ Range[-(n - 1), n - 1], Max[#] <= n \[And] Min[#] >= 1 &]; MapAt[# + 1 &, board, satis]]


3

Your definition uses While incorrectly, in that the first argument should evaluate to True when you want to keep looping. The braces you wrap around the first argument mean that instead of True or False you'll get {True} or {False}. While has to see plain True; anything else is treated like False. Also, your conditions should be conjunctions, not ...


2

Update: Setting only the major diagonal to 1 (original post set both diagonals to 1): ClearAll[diagsF2, saF2]; diagsF2 = Module[{ind = {#, #2}},(Band[ind, Automatic, # {1, 1}] ->1) & /@ {1, -1}] &; saF2 = SparseArray[diagsF2[#1, #2], {#3, #4}] &; saF2[2, 3, 5, 5] // Normal (* {{0,1,0,0,0},{0,0,1,0,0},{0,0,0,1,0},{0,0,0,0,1},{0,0,0,0,0}} ...


5

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}


0

This seems to work although I have not tested it thoroughly. Also, it's a rather brute force approach, so I hope someone else will post a more elegant solution. g[0] = {{Θ, 0, 0, 0, T, 0}, {u Θ, ρ, 0, 0, T u, 0}, {v Θ, 0, ρ, 0, T v, 0}, {w Θ, 0, 0, ρ, T w, 0}, {-1 + H Θ, u ρ, v ρ, w ρ, H T + ρ Ω, (5 ρ)/3}, {k Θ, 0,0, 0, k T, ρ}} ...


2

All the good answers are given. For fun, here is one using SparseArray {n, m} = Dimensions[x]; x = SparseArray[{{i_, j_} /; j == 1||j == m||i == 1||i == n} :> {x[[i, j]]}, {n, m}]; MatrixForm[x]


3

A variation on @rasher's post: border = Module[{a = ConstantArray[0, Dimensions@#], i = {1, -1}}, {a[[i]], a[[All, i]]} = {#[[i]], #[[All, i]]}; a] & border@x //MatrixForm and another SparseArray variation border2 = Module[{a = ConstantArray[0, Dimensions@# - 2], d = Dimensions@#}, # SparseArray[Band[{2, 2}] ...


7

This performs quite well on large matrices, seems to outrun the others I've tested so far: Module[{z = ConstantArray[0, Dimensions@#]}, z[[1, All]] = #[[1, All]]; z[[All, 1]] = #[[All, 1]]; z[[-1, All]] = #[[-1, All]]; z[[All, -1]] = #[[All, -1]]; z] & For really large arrays, it would behoove one to work in the sparse domain, where the ...


0

Here's a method that uses LeviCivita and defines the cross product in terms of its index notation expression: Cr[ms_, a_] := Map[Sum[ LeviCivitaTensor[3][[#, j, k]] ms[[j]] a[[k]], {j, Range[3]}, {k, Range[3]} ] &, Range[3]] /; 3 == Length[ms] == Length[a] In dimensions other than 3, the analogously defined cross product is not a ...


5

n = Dimensions[x]; ReplacePart[x, {i_, j_} /;2 <= i <= n[[1]] - 1 && 2 <= j <= n[[2]] - 1 :> 0] another way: MapAt[0 &, x, {2 ;; -2, 2 ;; -2}]


2

# ArrayPad[ConstantArray[0, Dimensions@# - 2], 1, 1] &@ Array[Times, {5, 8}] or # SparseArray[# -> 1 & /@ Flatten[{#, Reverse@# } &@ {_, #} & /@ {1, -1}, 1], Dimensions@#] &@ Array[Times, {5, 8}]


7

Although I believe that Kuba's first method is the best approach here is another: zerofill[a_] := a (1 - BoxMatrix[#/2 - 2, #]) & @ Dimensions @ a Now: Array[Times, {5, 8}] // zerofill // MatrixForm $\left( \begin{array}{cccccccc} 1 & 2 & 3 & 4 & 5 & 6 & 7 & 8 \\ 2 & 0 & 0 & 0 & 0 & 0 & 0 ...


11

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


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}]]


1

Much has already been said about this problem, but maybe this solution still might be helpful. First we define an auxiliary vector In[18]:= va = Array[a, 3] Out[18]= {a[1], a[2], a[3]} with which it is trivial to calculate the cross product: In[19]:= Cross[va, {1, 2, 3}] Out[19]= {3 a[2] - 2 a[3], -3 a[1] + a[3], 2 a[1] - a[2]} Now we replace the ...


4

The problem here can arise because of numerical underflow which appears for sufficiently large dimension of the problem. Some numerically very small number multiplies the parameter "a" and therefore "a" does not appear in the "solution". Consider a simple example Define the matrix m (fill it with random numbers, here exponentially distributed) In[263]:= ...


1

This may not be your intention, however, please note Mathematica 9.0 has built-in MultinormalDistribution, where you can enter covariance matrix $\mathbb\Sigma$. For example: mnd = MultinormalDistribution[{1, 2, 3}, {{2, 1/2, -1/3}, {1/2, 1, 0}, {-1/3, 0, 2/3}}]; funs = {Mean, Variance, Skewness, Kurtosis, Composition[MatrixForm, Correlation]}; ...


5

There is indeed a generic expression for (the essential part of) your integral which leaves the dimension n open. (We will use n istead of k and s = Sigma^(-1) for the matrix in the exponent). Main idea The main idea is to use the function Sequence (and, of course, delayed assingment). Consider an informal expression of the type Integrate[ ...


5

The two eigenvalues are degenerate. In general whenever you have degenerate eigenvalues there is arbitrariness in how to select the eigenvectors. You can construct a constant vector from the two degenerate eigenvectors like so: m = Import["https://dl.dropboxusercontent.com/u/63413473/ExampleMatrix.mx"]; {evals, evecs} = Eigensystem[m, -2]; You can check ...


1

one way (if I understand you right) Clear[i, j]; n = 10; {upper, lower, diag} = RandomReal[1, {3, n}]; mat = SparseArray[{{i_, j_} /; j == (i + 1) :> upper[[j]], {i_, j_} /; j == (i - 1) :> lower[[i]], {i_, j_} /; j == i :> diag[[i]]}, {n, n}];


1

As Oska has commented N is a protected symbol. Some other approaches: n = 4; mat = ConstantArray[1, {n, n}]; ReplacePart[mat, {{2, 3} -> 23, {4, 3} -> 43}] gives: {{1, 1, 1, 1}, {1, 1, 23, 1}, {1, 1, 1, 1}, {1, 1, 43, 1}} or Normal@SparseArray[{{2, 3} -> 23, {4, 3} -> 43}, {n, n}, 1] gives: {{1, 1, 1, 1}, {1, 1, 23, 1}, {1, 1, 1, 1}, ...


1

n = 4; A = ConstantArray[1, {n, n}] A[[2, 3]] = 23; A[[4, 3]] = 43; A {{1,1,1,1},{1,1,1,1},{1,1,1,1},{1,1,1,1}} {{1,1,1,1},{1,1,23,1},{1,1,1,1},{1,1,43,1}} n = 4; A = ConstantArray[1, {n, n}]; (A[[Sequence @@ #]] = FromDigits@#) & /@ Flatten[Table[{i, j}, {i, 1, 4}, {j, 1, 4}], 1]; A // MatrixForm $\left( \begin{array}{cccc} 11 & 12 & ...


1

I don't think you can "follow" the steps taken, but you surely can see how the resulting matrix is formed by "augmenting" your matrix with the identity. Following the last example on the docs about RowReduce[]: m = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}; a = Transpose[Join[Transpose[m], IdentityMatrix[Length[m]]]]; MatrixForm[r = ...



Top 50 recent answers are included