Tag Info

Hot answers tagged

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


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


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[%] (* ...


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


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


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}


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


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


5

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


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


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


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]


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


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


4

Look at what you get when you do e.g. f[1,1,1] and Conjugate[f[1,1,1]]. As the docs for Conjugate state, "Conjugate does not always propagate into arguments", and here it does not propagate into Cos and Sin. A solution seems to be to do f[kx_, ky_, t_] := -t E^(-I kx a) (1 + 2 E^(I (3 kx a)/2)*Cos[Sqrt[3]/2 ky a]); BlockA[kx_, ky_, t_] := ...


4

Matrices (and also vectors and other tensors) are multipled using Dot. Using your code, just replace * by . (I also removed all ('s and )'s as they don't do anything in this context. {{x, y, 1}}.{{a, b/2, d/2}, {b/2, c, e/2}, {d/2, e/2, f}}.{{x}, {y}, {1}} Result:


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


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


3

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


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.


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


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.


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


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]



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