New answers tagged

1

Start with: MatrixForm[A = {{1, 2, 3, a}, {4, 5, 6, a^2}, {7, 8, 9, a^3}}] Which gives the result: $$\begin{bmatrix} 1 & 2 & 3 & a\\ 4 & 5 & 6 & a^2\\ 7 & 8 & 9 & a^3 \end{bmatrix}$$ Then: r1 = A[[1]]; r2 = A[[2]]; r3 = A[[3]]; Then: MatrixForm[A = {r1, r2 - 4 r1, r3 - 7 r1}] Which gives the result: ...


0

If you make your A matrix a function (but avoid starting with capital letters), like aMatrix[x_] := ... then you can use Nest: Nest[aMatrix, x0, 100] where x0 is the starting vector.


5

Iterating @J.M.'s comment: This problem has no exact solution. With[{ matrix = {{0.8111, 0.4867, -0.3244}, {a, b, 0}, {c, d, e}} }, Print[matrix.Transpose[matrix]]; Solve[ matrix.Transpose[matrix] == IdentityMatrix[3], {a, b, c, d, e} ] ] (* {{0.999995,... *) (* {} *) That is, the first column's first entry is not $1$, so there is ...


1

SeedRandom[5] pts = RandomReal[1, {6, 2}]; pts = pts[[FindShortestTour[pts][[2]]]]; am = RandomChoice[{.7, .3} -> {0, 1}, {6, 6}]; AdjacencyGraph using the polygon vertices as vertex coordinates: Labeled[AdjacencyGraph[am, VertexCoordinates -> pts, DirectedEdges -> False, Vertexlabels->"Name", Prolog -> {Yellow, ...


0

Here's an example where the adjacency matrix shows a link from pt[[1]] to pt[[4]] and from pt[[2]] to pt[[3]]: pts = {{0, 0}, {0, 1}, {1, 1}, {1, 0}}; adMat = {{0, 0, 0, 1}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 1, 0, 0}}; myfig = Graphics[ {{Opacity[0.2], Yellow, Polygon[pts]}, {Red, PointSize[0.02], Point[pts]}, Line@({pts[[#1]], ...


0

Here is the fixed notebook. Your main problems were that the third elements of the first argument in ListContourPlot were imaginary and that you switched two values in Part in fsingle. In the notebook, I highlighted lines I have changed and wrote why I changed them in the comments (there were some inefficiencies). However, please try to post your actual ...


2

Using Smith Normal Form you can get two integer matrices with determinant 1 that would satisfy the equation $$X1.K.X2 = K_2$$ May be this is a good start you can use... resK = SmithDecomposition[K]; MatrixForm /@ resK resK2 = SmithDecomposition[K2]; MatrixForm /@ resK2 resK[[2]] == resK2[[2]] (* True *) K2 == ...


2

I learned a lot from WReach's and Leonid's answers and I'd like to make a small contribution: It seems worth emphasizing that the primary intention of the list-valued second argument of Flatten is merely to flatten certain levels of lists (as WReach mentions in his List Flattening section). Using Flatten as a ragged Transpose seems like a side-effect of ...


0

What you want to do is actually very simple and can accomplished by a single line of code. With[{db = .01}, v = Interpolation[Table[{b, b^2}, {b, 0, 1, db}]]]; Then Plot[v[b], {b, 0, 1}]


4

Thanks to MarcoB's pointer, I realized the following properties of conjugating one of the numbered Pauli matrices by $A$, $B$, or $C$. Table[ConjugateTranspose[PauliMatrix[i]] == PauliMatrix["A"].PauliMatrix[i].MatrixPower[PauliMatrix["A"], -1], {i, 3}] Table[-Transpose[PauliMatrix[i]] == PauliMatrix["B"].PauliMatrix[i].MatrixPower[PauliMatrix["B"], ...


5

This could be done with a custom function for the first argument of Inner that treats a differently (it's just a more convenient form of expressing your original idea). For example, consider this: ClearAll[f]; f[a, x_] := a[x] f[x_, a] := a[x] f[x_, y_] := x y Now for your first example: Inner[f, {{a, b}, {c, d}}, {h, k}] (* {b k + a[h], c h + d k} *) ...


3

Sorry, correcting a typing error in the matrix leads to a different conclusion: Eigenvalues as well as determinant factorize, which points to solubility, but still, I haven't found the matrix factors. The correct matrix is a = {{1/r, 1/\[Mu][r]}, {\[Mu][r]/r f[n], -(3/r^2)}}; Where f[n] = n(n+1)-2 The determinant is Det[a] // Factor (* Out[194]= ...


3

This is a very quick-and-dirty, but gives 4X speed-up (7X with tweak for symmetry) on my crappy netbook for the n=8 case, don't have time or patience to test bigger cases to see scaling differences. Perhaps a description of what you're trying to calculate? It appears to be some combinatorial problem, there may well be a much more efficient scheme to do ...


0

In[1]:= b=Range[0,.9,0.1]; Length@b p=Range[.25,.75,.05] Length@p Out[2]= 10 Out[3]= {0.25,0.3,0.35,0.4,0.45,0.5,0.55,0.6,0.65,0.7,0.75} Out[4]= 11 In[5]:= Information@Interpolation; Interpolation[{{{Subscript[x, 1],Subscript[y, 1],\[Ellipsis]},Subscript[f, 1]},{{Subscript[x, 2],Subscript[y, 2],\[Ellipsis]},Subscript[f, 2]},\[Ellipsis]}] constructs an ...


2

I am a novice user so please forgive me if this is a bit clunky! Using Transpose and ArrayReshape mat = {{1}, {2}, {3}}; n = 11; ArrayReshape[Transpose[Table[mat, {n}]], Dimensions[mat] {1, n}] // MatrixForm


4

The way I remember it from my Linear Algebra class is like this: Clear[b]; A = {{-1, 1, -1, 0, 0, 0}, {1, 0, 0, -1, -1, 0}, {0, -1, 0, 0, 1, -1}, {0, 0, 1, 1, 0, 1}}; bb = Array[b, Length@A]; Thread[NullSpace@Transpose@A . bb == 0] (* {b[1] + b[2] + b[3] + b[4] == 0} *) That is, the condition for a solution to A.x == b to exist is that b be in the ...


1

Guessing OP meant f1*f2 == f1*f3 == f1* f4 == f1*f5 == f2*f3 == f2*f4 == f2*f5 == f3*f4 == f3*f5== f4*f5 ==0, matrix = {{f1, -f2, -f2, f3}, {f4, -f1, -f1, f2}, {f4, -f1, -f1, f2}, {f5, -f4, -f4, f1}}; assumptions = Thread[(Subsets[Times[f1, f2, f3, f4, f5], {2}]) == 0]; ToRadicals @ FullSimplify[Eigensystem[matrix], Assumptions -> assumptions]


1

KroneckerProduct kpF = KroneckerProduct[{ConstantArray[1, #2 ]}, #] &; SparseArray and Band saF = SparseArray[(Band[{1, 1}, {1, #2} Dimensions[#], {1,1}] -> #)] &; Examples: mat = {{0, 0, 1, 1}, {0, 1, 0, 1}}; saF[mat, 5] // MatrixForm kpF[mat, 3] // MatrixForm


11

You can use Reduce[] to find a set of all conditions as follows: A = {{-1, 1, -1, 0, 0, 0}, {1, 0, 0, -1, -1, 0}, {0, -1, 0, 0, 1, -1}, {0, 0, 1, 1, 0, 1}}; b = {b1, b2, b3, b4}; x = {x1, x2, x3, x4, x5, x6} allConditions=Reduce[A.x == b, x] This returns b1 == -b2 - b3 - b4 && x3 == b2 + b3 + b4 - x1 + x2 && x5 == -b2 + x1 - x4 ...


0

I absolutely support JasonB's suggestions, especially hdf5 seems a good format for such data when you want to be able to read with other software. But for the case where you only need to write and read with Mathematica, I think the MX format at least needs to be mentioned as well: it is by far the easiest and fastest way to store arbitrary expressions (not ...


3

Perhaps I'm missing something in the question, but why not just: new=Upsample[old, 3, 2];


1

A different SparseArray approach: n = 3 (m = RandomInteger[{1, 5}, {n, n}]) // MatrixForm big = SparseArray[ {i_ /; Mod[i + 1, 3] == 0, j_ /; Mod[j + 1, 3] == 0} :> #[[(i + 1)/3, (j + 1)/3]] , {3 Length@#, 3 Length@#}] &@m; MatrixForm[big]


0

If you plan to use your data in MMA only you can do a = RandomReal[1, {1000, 3, 3}]; Dimensions[a] a >> testExport.dat b = << testExport.dat; Dimensions[b] a == b


3

KroneckerProduct f5 = KroneckerProduct[#, {{0, 0, 0}, {0, 1, 0}, {0, 0, 0}}] &; f6 = KroneckerProduct[SparseArray@#, SparseArray[{2, 2} -> 1, {3, 3}]] &; SparseArray and Band f1 = SparseArray[Band[{2, 2}, Automatic, {3, 3}] -> #,3 Dimensions[#]] &; or f1 = SparseArray[Band[{2, 2}, 3 Dimensions[#], {3, 3}] -> #] & ...


2

Here is one way -- represent the original array in sparse form, then replace the indices with the desired ones: m = RandomInteger[{-5, 5}, {3, 3}]; Normal@SparseArray[Drop[ArrayRules@SparseArray[m] /. {x_, y_} -> {3 x - 1, 3 y - 1}, -1]] // MatrixForm More generally, and controlling for the ultimate size of the matrix: n = 3; m = ...


3

You can export as a MATLAB .mat file if your array has less than 4 dimensions, rand = RandomReal[1, {1000, 3, 3}]; Dimensions@rand rand[[454, 1, 2]] Export["random.mat", rand]; (* {1000, 3, 3} *) (* 0.786307 *) When you import it again, you have the same dimensions and the elements are the same rand2 = Import["random.mat"]; Dimensions@rand2 rand2[[454, ...


0

Since you say that you still do not get the output you desire using KroneckerProduct, I am guessing that you should try restarting the kernel. In any case, this should also fit your needs: mat1 = Array[m1, {2, 2}]; mat2 = Array[m2, {2, 2}]; KroneckerProduct[mat1, mat2] // MatrixForm


0

Perhaps X = IdentityMatrix[2] Y = Array[y, {2, 2}] TensorProduct[X, Y] // MatrixForm $\left( \begin{array}{cc} \left( \begin{array}{cc} y(1,1) & y(1,2) \\ y(2,1) & y(2,2) \\ \end{array} \right) & \left( \begin{array}{cc} 0 & 0 \\ 0 & 0 \\ \end{array} \right) \\ \left( \begin{array}{cc} 0 & 0 \\ 0 & 0 \\ \end{array} ...


1

You could introduce further conditional definitions for H which will prevent those computations whose results would end up being thrown away. For instance, you could add: H[i_, j_, k_, l_] /; (i > j || k > l) = Missing[]; As a toy example: m = Table[H[n, 2, 3, 4], {n, 1, 10}] (* Out: {(3 Sqrt[5])/128, (5 Sqrt[15])/256, Missing[], Missing[], ...


2

Here are couple of quick tips. Lets say this is your matrix mat = SparseArray[{{i_, j_} /; Abs[i - j] == 3 -> 1, {i_, i_} -> 1}, {200, 200}]; This is the conventional way to find EigenSystem Eigensystem[SparseArray[{{i_, j_} /; Abs[i - j] == 3 -> 1, {i_, i_} -> 1}, {200, 200}]]; // AbsoluteTiming {53.6551, Null} Now just change the ...


1

SeedRandom[1] s1 = RandomInteger[{-3, 3}, {5, 5}]; s2 = RandomInteger[{-3, 3}, {5, 5}]; Temporarily define Indeterminate as 0: Block[{Indeterminate = 0}, 1./2 ArcTan[s1, s2]]


2

If all the elements in the matrix are functions, you can also use Block[{Times = (# @ #2 &)}, {{a, b}, {c, d}}.{h, k}] {a[h] + b[k], c[h] + d[k]}


5

Picking up on Marius tip on Inner in the comments: Inner[Apply[#1, {#2}] &, {{a, b}, {c, d}}, {h, k}] And @ciao offered a better version in comments: Inner[#1[#2] &, {{a, b}, {c, d}}, {h, k}]


0

Manipulate[Row[{ArrayPlot[mat[[;; k, ;; k]], ImageSize -> 300], AdjacencyGraph[mat[[;; k, ;; k]], ImageSize -> {300, 300}]}], {{mat, ConstantArray[0, {50, 50}]}, None}, {k, 4, None}, Dynamic[Column[{InputField[Dynamic[k, (k = Clip[IntegerPart@#, {2, 20}]) &], Number, FieldSize -> {8, 1}], ...


1

A bit simple minded: DynamicModule[{n = 3, bs}, Panel[Column[{Slider[Dynamic[n, {(n = #) &, (bs = PadRight[bs, {n, n}]) &}], {2, 100, 1}], Row[{Dynamic[Grid[Array[Checkbox[Dynamic[bs[[##]]], {0, 1}] &, ...


2

You can use NumberFormat option in ScientificForm to do this. For example cformat[x_, numDigts_] := ToString[ ScientificForm[x, numDigts, NumberFormat -> (Row[If[#3 == "", {#1}, {#1, "E", #3}]] &)]] then cformat[1.2345678*^-10, 4] (* "1.235E-10" *) However, since your data is all in the range of 0 to 10, there would be no "E" in the ...


5

This answer compares two dimension reduction techniques SVD and Non-Negative Matrix Factorization (NNMF) over a set of images with two different classes of signals (two digits below) produced by different generators and overlaid with different types of noise. Note that question states that the images have one class of signals: I have a stack of images ...


10

As requested by Anton. I halved the amount of noise because otherwise some images have barely any signal left. As you can see below, we are still putting in a significant amount of noise. (To conserve space I'm only visualizing the first ten images in this answer, but the denoising is happening over all 100 test images.) SeedRandom[2016] (* for ...


3

The numerical definitions you give later modify the calculation of the symbolic definitions you use earlier. If you clear all your variables at the start of your calculation, the problem goes away and repeatable results are obtained. In particular, it is the numerical definition of k that seems to muddy the waters. In order to do what you want, a far better ...


15

Start data First let us get some images. I am going to use the MNIST dataset for clarity. (And because I experimented with similar data some time ago.) MNISTdigits = ExampleData[{"MachineLearning", "MNIST"}, "TestData"]; testImages = RandomSample[Cases[MNISTdigits, (im_ -> 0) :> im], 100] Let us convince ourselves that all images have the same ...


11

Here is a very short solution: qf = a x^2 + b y^2 + c z^2 + 2 d x y + 2 e x z + 2 f y z; 1/2 D[qf, {{x, y, z}, 2}] (* ==> {{a, d, e}, {d, b, f}, {e, f, c}} *) This is just an application of the answer to Quick Hessian matrix and gradient calculation.


6

Here is a way that yields symmetric matrix (for this example you could just write it down): m=Module[{r = {x -> 1, y -> 2, z -> 3}, tu = Tuples[{x, y, z}, 2]}, Normal@SparseArray[(## /. r) -> Coefficient[qf, Times @@ ##]/(2 - Boole[#[[1]] === #[[2]]]) & /@ tu, {3, 3}]] yields: {{a, d, e}, {d, b, f}, {e, f, c}} Check: ...


10

I think you need CoefficientArrays: mat = Last@CoefficientArrays[qf, {x, y, z}, "Symmetric"->True]; {x, y, z}.mat.{x, y, z} == qf // Simplify (* True *)


10

First answer (extended comment actually) You have to define better your objective function. For example, the following works: ClearAll[mat, minev] SeedRandom[1] rm = RandomInteger[10, {40, 40, 3}]; mat[t_] := N[rm.{1, t, t^2}]; minev[t_?NumericQ] := First@Eigenvalues[mat[t], -1]; Take[Table[minev[t], {t, 0, 1, .01}], 3] (* {-0.864071 - 1.30548 I, ...


1

This isn't much different than JasonB's answer in substance, but it's easier to debug and it's usually how I first approach problems with lots of steps: Module[ {nullPos, nullGroup, nullReplacements}, nullPos = Position[startingMatrix, "Null"]; nullGroup = Last@startingMatrix[[First@#]] & /@ nullPos; nullReplacements = Cases[lookupMatrix, {___, x_} ...


2

This looks convoluted, but it matches the requirements you set up Fold[ Function[{matrix, index}, ReplacePart[matrix, index -> RandomChoice[ Select[ lookupMatrix, (Last@# == startingMatrix[[First@index, -1]] &)][[All, Last@index]] ]]], startingMatrix, Position[startingMatrix, "Null"]] (* {{1, 2, 3, 4, 5, 5.5, 6, 7, ...


3

ClearAll[mat, minev] SeedRandom[1] rm = RandomInteger[10, {400, 400, 3}]; mat[t_] := rm.{1, t, t^2}; minev[t_?NumericQ] := Eigenvalues[mat[t], -1]; DiscretePlot[Evaluate[minev[t]], {t, 0, 1, .01}]


4

Reverse /@ Partition[ {c1, c2, c3, c0}, 4, 1, {1, 1}, {c1, c2, c3, c0}] Edit or more simple : Reverse /@ Partition[{c1, c2, c3, c0}, 4, 1, {1, 1}]


4

cm = ToeplitzMatrix[{c0, c1, c2, c3}, RotateRight[Reverse[{c0, c1, c2, c3}]]]; cm // MatrixForm


3

Do you really need to use ToeplitzMatrix? What about following? MatrixForm@Transpose@NestList[RotateRight, #, Length[#]-1] &@{1, 2, 3, 4}



Top 50 recent answers are included