Tag Info

New answers tagged

1

A For-loop is a poor choice for your calculation in Mathematica. Better, because it's simpler and faster, is sets = Table[Complement[Range[10], {i, i + 1}], {i, 9}]; which has the additional advantage that the results are available for further calculations. To get the results printed out nicely, use Column Column @ sets


2

Yes. But don't assume that the vertex named 1 is the first one, etc. That is often not the case. You can get the order of vertices using VertexList. You can get the index of a certain vertex using VertexIndex.


3

You For syntax is just wrong. Try r = Range[10] For[i = 1, i <= 9, i++, k = Complement[r, {i, i + 1}]; Print[k]] and avoid capital letters for your symbol names. K has a build-in meaning Information[K] K is a default generic name for a summation index in a symbolic sum.


1

Changing B*list to B.list seems to solve the problem. Also, I recommend dropping unnecessary decimal points from myfun14. Doing so gives (* {x[1] -> 0.5, x[2] -> 0.273438, x[3] -> 0.0128174, x[4] -> 0.125601, x[5] -> 0.00588754, x[6] -> 0.000275978, x[7] -> 0.0000129365, x[8] -> 0.0625006, x[9] -> 0.00292972, x[10] ...


2

Another approach is to use DiagonalMatrix and its optional third argument n = 5; mat[n_]:= DiagonalMatrix[ConstantArray[n, n]] + DiagonalMatrix[ConstantArray[-2, n - 1], 1] + DiagonalMatrix[ConstantArray[-2, n - 1], -1];


2

Assuming bbgodfrey's interpretation, I'd also expect this to be faster if dimension is large: ToeplitzMatrix[PadRight[{#, -2}, #]] & Though more memory hungry, it produces a packed array, so depending on what you're doing, it may have some performance benefits in use compared to a sparse realization (but the reverse could also be true, again, depends ...


7

The following function, along the lines of the suggestion by Guesswhoitis, produces what you appear to want. m[r_] := SparseArray[{Band[{1, 1}] -> n, Band[{2, 1}] -> -2, Band[{1, 2}] -> -2}, {r, r}] It is unclear whether the n in the picture is the same as n, the dimension of the matrix. (Do not use N, which is a reserved term.) If not, change ...


7

In Mathematica, the type of variable is interpreted based on the context, and if there are no values associated with the variable, then often nothing is done. When you write PauliMatrix[1].f, since there are no values/rules associated with f, this just returns {{0, 1}, {1, 0}}.f because the function Dot doesn't evaluate unless the arguments are vectors, ...


4

You can also approach this using images (rather than graphics). The command ColorCombine places image a in the red channel, b in the green channel, and c in the blue channel: Nx = 10; Ny = 10; a = Table[RandomReal[], {i, 1, Nx}, {j, 1, Ny}]; b = Table[RandomReal[], {i, 1, Nx}, {j, 1, Ny}]; c = Table[RandomReal[], {i, 1, Nx}, {j, 1, Ny}]; ...


4

Or, if you want to produce a Graphics directly, these produce identical results: Graphics@Raster@Transpose[{a, b, c}, {3, 1, 2}] Graphics@Raster[MapThread[List, {a, b, c}, 2]]


3

It is as simple as Nx = 10; Ny = 10; a = Table[RandomReal[], {i, 1, Nx}, {j, 1, Ny}]; b = Table[RandomReal[], {i, 1, Nx}, {j, 1, Ny}]; c = Table[RandomReal[], {i, 1, Nx}, {j, 1, Ny}]; ArrayPlot[Transpose[{a, b, c}, {3, 1, 2}], ColorFunction -> RGBColor] Now you can set ColorFunction -> RGBColor and you probably want to look into ...


4

A couple of options: Range[100] ~Partition~ 10 Array[10 # + #2 - 10 &, {10, 10}] Just for fun, assuming no collisions: ArrayComponents @ RandomReal[1, {10, 10}] A rather inefficient use of SparseArray: SparseArray[{i_, j_} :> 10 (i - 1) + j, {10, 10}] // Normal And a nice one from J.M. in the comments: NestList[# + 10 &, Range[10], 9]


8

This is not a complete answer, but it's too long for a comment. It doesn't completely work, but perhaps it might inspire other answers. The idea is to use graph theory and flows. I shall just look at the 3x3 case. First we construct a graph of 9 source nodes and 9 sink nodes. The source nodes flow costlessly straight into the sink nodes, and the sink ...


4

If Table is part of your actual operation you will be served by learning Array: Array[#, {2, 2}] & /@ {Plus, Subtract, Times, Divide} { {{2, 3}, {3, 4}}, {{0, -1}, {1, 0}}, {{1, 2}, {2, 4}}, {{1, 1/2}, {2, 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}}} *)


3

Let the imported sound be sound = ExampleData[{"Sound", "JetSound"}] One can extract the SampledSoundList with sound[[1]] This example has 2 channels and a sampling rate of 44100 Hz, as can be seen not only in the sound object box, but also from Length@sound[[1, 1]] 2 sound[[1, 2]] 44100 To get the list of the amplitudes of the first ...


3

An alternative using Replace to do this: mytable = Table[{i, j}, {i, 1, 2}, {j, 1, 2}]; Replace[mytable, List[a_, b_] -> #[a, b], {-2}] & /@ {Plus, Subtract, Times, Divide} {{{2, 3}, {3, 4}}, {{0, -1}, {1, 0}}, {{1, 2}, {2, 4}}, {{1, 1/2}, {2, 1}}}


7

You very nearly had it. What you need, instead of Map[], is Apply[]. This can then be combined with Map[], like so: mat = Table[{i, j}, {i, 2}, {j, 2}]; Apply[#, mat, {2}] & /@ {Plus, Subtract, Times, Divide}


5

You might just map the Maps ops = {plus, subtract, times, divide} = Function[op, Map[op[#[[1]], #[[2]]] &, Table[{i, j}, {i, 1, 2}, {j, 1, 2}], {2}]] /@ {Plus, Subtract, Times, Divide} {{{2, 3}, {3, 4}}, {{0, -1}, {1, 0}}, {{1, 2}, {2, 4}}, {{1, 1/2}, {2, 1}}}


5

There is a bug in your code which causes one of the factors in the Dot product to have excessively large imaginary parts (of the form 0. +1.32133*10^246 I). This means the multiplication can't be done in machine precision arithmetic, and as a result the calculation slows down considerably. The mistake is that the exponentiation of the eigenvalues must ...


2

Another way using Graphics primitives Raster and Text: dimdata = Reverse@Dimensions@data; map = data[[All, ;; -2]] // Raster[#, {{0, 0}, Reverse@Dimensions@#}, MinMax@#, ColorFunction -> "Rainbow"] &; text = Text @@@ Thread[{data[[All, -1]], Thread@{First@dimdata, Range[Last@dimdata]} - 0.5}]; then Graphics[{map, text}, AspectRatio -> ...


11

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


2

I had actually answered this in a different thread that was eventually closed. Since that answer fits perfectly for this question, I'll use it here: I will use $\sigma$ as an abbreviation for PauliMatrix. The goal is to get back a result in terms of the symbolic matrices $\sigma$. Fortunately, this can always be done because the Pauli matrices when ...


2

Try the following: SetAttributes[simplifyPM, HoldFirst] simplifyPM[expression_] := Module[ {intermediate}, intermediate = HoldForm[expression] //. PauliMatrix[a_].PauliMatrix[a_] :> IdentityMatrix[Dimensions[PauliMatrix[a]]]; intermediate /. IdentityMatrix[_].m_?MatrixQ :> m ] You can then use it as follows: results = ...


2

Here is a simpler answer: adj[m_] := Inverse[m] Det[m]


6

Updated code Based on some wonderful comments below, here is some simplified, more robust code. MatrixPlot[ PadRight[Drop[data, None, -1], Dimensions[data]] , ColorRules -> {0 -> White} , Epilog -> MapIndexed[ Text[#1, Flatten[{Last[Dimensions[data]] - 0.5, #2 - 0.5}]] & , Reverse@data[[All, -1]] ] ] Original code Does this ...


4

SeedRandom[42]; pts = {{2, 4}, {1, 3}, {5, 7}}; a = RandomInteger[{1, 10}, {7, 7}] Extract[a, pts] (* {2, 9, 10} *) Grid[a, Background -> {None, None, Thread[pts -> Red]}]


3

The "TreatRepeatedEntries" method may be impossible to beat but the more mundane method is to use AddTo. Starting with the definitions in your question: v = {{2}, {3}, {4}}; locs = {{1, 2}, {1, 3}, {1, 4}}; m = ConstantArray[0, {6, 6}]; comb = Partition[Flatten[Riffle[v, locs]], 3]; We need merely: m[[##2]] += # & @@@ comb; Now: m {{0, 2, ...


2

put all your added values in a sparse array of same dimension and add the whole matrix: m = ConstantArray[0, {6, 6}] v = {2, 3, 4, 6} locs = {{1, 2}, {3, 3}, {1, 4}, {1, 2}} the GatherBy in here is taking care of repeated positions (Note @GuessWhoItIs shows a cleaner approach , this does not rely on remembering an undocumented system option however.. ) ...


4

Caveat: the technique below seems to fail for matrices as large as the OP wants, and I'm not sure why. See the last paragraph. The eigenvalues are the roots of the characteristic polynomial of the matrix; and buried deep within Mathematica is a method to create a plot of the roots of a polynomial as a function of a parameter d = 6; samplemat = ...


1

How about using MapAt? pos = {{1, 2}, {1, 3}, {1, 4}, {2, 6}, {2, 6}}; add = {2, 3, 4, 10, 11}; Block[{i = 0, a = Reverse@add[[Ordering@pos]]}, MapAt[(i++; Plus[#, a[[i]]]) &, m, pos]] Not the most elegant, but seems to work well, and handles repeat indices. It seems MapAt does some weird ordering of the indices before applying them. Maybe the ...


1

m = ConstantArray[0, {6, 6}] v = {{2}, {3}, {4}} locs = {{1, 2}, {1, 3}, {1, 4}} comb = Partition[Flatten[Riffle[v, locs]], 3] result = Fold[ ReplacePart[#1, {#2[[2]], #2[[3]]} -> Part[#1, #2[[2]], #2[[3]]] + #2[[1]]] & , m, comb] {{0, 2, 3, 4, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, ...


7

(Untested, so CW) Consider using MapThread[] along with ReplacePart[]: MapThread[ReplacePart[m, #1 :> Extract[m, #1] + #2] &, {{{1, 2}, {1, 3}, {1, 4}}, {2, 3, 4}}] Another possibility involves the use of SparseArray[]: SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> 1}]; pos = {{1, 2}, {1, 3}, {1, 4}}; add = {2, 3, ...


0

Here is a method that computes only the smallest eigenvalue and checks that it's greater or equal to zero. This can be done by using a shift as in this answer, or for large matrices by using the option Method -> {"Arnoldi", "Criteria" -> "RealPart"} for Eigenvalues: Clear@positiveSemiDefiniteQ positiveSemiDefiniteQ[mat_?MatrixQ] := ( ...


3

(Internal`StringToDouble /@ StringSplit[#, ","]) & /@ Flatten[data]


8

You are correct to say that this is a problem with the precision of the numbers involved. You can set the precision of those numbers explicitly: SetPrecision[{{3.9999999999998025*^14 + 0.001*I, 3.141592653589793 - 3.1405926535897932*I}, {3.141592653589793 - 3.1405926535897932*I, 3.9999999999998025*^14 + 0.001*I}}, 20]; Eigenvalues[%] (* ...


3

As commented by Guess who it is, this can be done using the expression DeleteDuplicates[Flatten[Position[#, Max[#]] & /@ matrix]] This first finds the index of all maxima (including degenerate ones) and then removes any duplicate entries. This is indeed what I was looking for in my original question.


1

This should give some ideas. I add a safety valve in case the rank is always 5. indx = 0; det = 1; While[det != 0 && indx < 100, indx++; l = RandomSample[ovld, 5]; det = Det[l];] {indx, l} (* Out[163]= {3, {{5, 4, 3, 2, 1}, {4, 3, 2, 1, 5}, {2, 1, 5, 4, 3}, {1, 2, 3, 4, 5}, {2, 3, 4, 5, 1}}} *)


3

You are missing a semicolon just before the statement defining each piece of S. Once you fix that, your code will run. But before I close your question, I just wanted to point out that a triply nested For loop is an extremely convoluted way to go about this. You didn't give us Xd, so let's pretend it is defined like this: Xd = RandomReal[{0, 2}, {246, ...



Top 50 recent answers are included