New answers tagged matrix
3
You do not need to disassemble the adjacency matrix. You can assign colour within a single graph.
names = {"A1", "A2", "A3", "A4", "A5", "V1", "V2", "V3", "V4", "V5"};
type = StringTake[#, 1] &; (* what type of node? A or V? *)
colorRules = {
{"A", "A"} -> Blue,
{"V", "V"} -> Red,
{"A", "V"} -> Purple
};
AdjacencyGraph[{"A1","A2",...
7
Maybe something like:
k = 10;
m = 10;
SeedRandom[1]
m1 = SparseArray@RandomInteger[1, {k, m}];
A = UpperTriangularize[m1] + Transpose[UpperTriangularize[m1, 1]];
labels = {"A1", "A2", "A3", "A4", "A5", "V1", "V2", "V3", "V4", "V5"};
To get the four submatrices from A you can use Partition and to get A from the four matrices you can use ArrayFlatten:
...
4
Here is an indirect route, which has the advantage of postponing operations like MatrixRank[] until the end.
Consider the identity
$$\begin{pmatrix}1&x&3\\2&4&5\\2&4&x\end{pmatrix}=\begin{pmatrix}1&0&3\\2&4&5\\2&4&0\end{pmatrix}+\begin{pmatrix}x&0\\0&0\\0&x\end{pmatrix}\begin{pmatrix}0&1&0\...
answered yesterday
0
One possible approach is to write out a list of possible invariants that could be involved in the result, e.g.
v2 = v1.v1
w2 = w1.w1
vw = v1.w1
ctr = Tr[cM]
c2tr = Tr[cM.cM]
vcv = v1.cM.v1
{...}
As far as I can tell, your expression only contains terms that are quadratic & quartic in the components of $\bf{v}$, $\bf{w}$, and $\bf{c}$, so there will be ...
5
Maybe you want this?
rho = 1/4 (KroneckerProduct[Id, Id] + KroneckerProduct[Id, v1.sigv] +
KroneckerProduct[w1.sigv, Id] +
Sum[cM[[i]][[j]] KroneckerProduct[sig[i], sig[j]], {i, 1, 3}, {j,
1, 3}]);
Tr[rho.rho.rho.rho] // Simplify
Most importantly, you must not use [ ] to group mathematical expression, use ( ) instead.
5
ReplacePart has a undocumented four variables form that permits this :
oldValuesList = {{1, 0}, {0, 1}}
newValuesList = {13, 14}
modifiedPositionsList = {{1, 1}, {1, 2}}
newValuesPositions = (* gives the origin of the new data *)
List /@ Range[Length[newValuesList]] (* simply {{1},{2}} *)
ReplacePart[oldValuesList
, newValuesList
, ...
7
ReplacePart[{{1, 0}, {0, 1}}, Thread[{{1, 1}, {1, 2}} -> {13, 14}]]
so
ReplacePart[m, Thread[li -> lr]]
in general.
But a CompiledFunction will probably do the job quicker because Thread[li -> lr] unpacks arrays. Let's see.
cReplacePart =
Compile[{{A0, _Real, 2}, {pos, _Integer, 2}, {val, _Real, 1}},
Block[{A = A0},
If[
1 <= ...
1
Max Rank
I use the following function to check if the matrix is of a maximum rank:
(* Max Rank? *)
MRQ[m_] := Minors[m, Min[Dimensions[m]]] != 0;
Usage example:
Reduce[MRQ[{{3 x^2, 3 y^2, 3 z^2}, {1, 1, 1}}], {x, y, z}]
results in:
x^2 - y^2 != 0 || x^2 - z^2 != 0 || y^2 - z^2 != 0
or
Solve[! MRQ[{{3 x^2 - 6 y, -6 x + 2 y}}], {x, y}]
in
{{x -> 0,...
2
We can also make use of the undocumented syntax of FindRoot:
Clear@myfun14;
myfun14[list_] :=
Module[{b, A, B},
b = Transpose@{{1/2, 1/4, 0, 1/8, 0, 0, 0, 1/16, 0, 0, 0, 0, 0, 0}};
A = DiagonalMatrix[ConstantArray[1., 13], -1]; A[[All, -1]] = list;
B = A + Sum[MatrixPower[A, (2^n - 15)]/2.^(n - 4), {n, 5, 50}];
(list - b - 1/32 B.list)]
...
5
ClearAll[visualizeDM, barLegend]
isoHcf = ColorData["TemperatureMap"];
visualizeDM[minmax_, is_: 80] := ArrayPlot[#,
ColorFunction -> Function[x, isoHcf[Rescale[x, minmax, MinMax@#]]],
Epilog -> MapIndexed[Text[#, #2 - .5] &, Reverse /@ Transpose[#], {2}],
FrameTicksStyle -> Directive[FontSize -> 12],
FrameTicks -> ...
3
It is not overly difficult to write a simple (but inefficient) method for symbolically performing Hessenberg decomposition, based on repeated similarity transformations with Householder matrices. It is interesting to compare the routine for QR decomposition in this answer with the Hessenberg decomposition function given below:
hesdec[mat_?SquareMatrixQ] := ...
answered Mar 17 at 13:19
5
m = {
{3, 1, 2},
{0, 5, 1},
{1, 4, 2},
{0, 6, 9},
{0, 4, 7},
{2, 6, 8}
};
Flatten[ConstantArray[#, #[[1, 1]]] & /@ Split[m, #2[[1]] == 0 &], 2]
$\left(
\begin{array}{ccc}
3 & 1 & 2 \\
0 & 5 & 1 \\
3 & 1 & 2 \\
0 & 5 & 1 \\
3 & 1 & 2 \\
0 & 5 & 1 \\
1 & 4 & 2 \\
0 &...
1
ClearAll[f]
f = Module[{m = #, p = SequencePosition[#, {{Except[0], __}, {0, __} ...}]},
Join @@ (Join @@ ConstantArray[m[[Span @@ #]], m[[#[[1]], 1]]] & /@ p)] &;
Examples:
a = {{3, 1, 2}, {0, 5, 1}, {1, 4, 2}, {0, 6, 9}, {0, 4, 7}, {2, 6, 8}};
MatrixForm /@ {a, f @ a}
SeedRandom[1]
b = RandomInteger[3, {7, 3}];
MatrixForm /@ { b, f @ b}
3
m = {{3, 1, 2}, {0, 5, 1}, {1, 4, 2}, {0, 6, 9}, {0, 4, 7}, {2, 6, 8}}
SequenceReplace[m, seq : {{x_ /; x > 0, __},
Repeated[{0, __}, {0, Infinity}]} :> Table[seq, x]]
Flatten[%, 2]
3
This could be a starter for discussions:
A = RandomInteger[{0, 3}, {6, 3}];
idx = Pick[Range[Length[A]], Unitize[A[[All, 1]]], 1];
B = Join @@ MapThread[
Join @@ ConstantArray[A[[#1 ;; #2]], A[[#1, 1]]] &,
{
idx,
Append[Rest@idx - 1, Length[A]]
}
];
Hm. Building the list of rows first and to read from A only once seems to be ...
3
Update:
ClearAll[sA]
sA = SparseArray[{Band[{1, 1}] -> #, Band[{1, 1 + Last@Dimensions[#[[1]]]}] -> #2}] &;
Example:
SeedRandom[1]
k = 4;
{rowdims, coldims} = RandomInteger[{2, 4}, {2, k}];
ClearAll[m1, m2, m3, m4, n1, n2, n3, ma, mb, mc, md, na, nb, nc];
ms = {m1, m2, m3, m4} = MapThread[Array[Function[{x, y}, Subscript[#, x, y]], #2] &,
...
6
A slightly different formulation and output from Alan's method:
fn[a_?MatrixQ, x_] :=
a ~Reverse~ 2 /. b_ :> (Diagonal[b, #2 - #] & @@@ Position[b, x])
Test:
Mod[Range@40, 12] ~Partition~ 8 // MatrixForm
fn[%, 7]
$\begin{array}{cccccccc}
1 & 2 & 3 & 4 & 5 & 6 & 7 & 8 \\
9 & 10 & 11 & 0 & 1 & 2 ...
7
reverseDiagonal[mA_, x_] := With[{mR = Reverse@mA},
Diagonal[mR, #] & /@ Apply[Minus@*Subtract, Position[mR, x], 2]
]
reverseDiagonal[{{1, 2, 3, 4}, {5, 6, 7, 7}, {9, 10, 11, 12}}, 7]
(* {{10, 7, 4}, {11, 7}} *)
You may want to map Reverse across the lists in this result.
6
You can try to autocompile this:
x = {{aa/2, ab, ac, ad}, {0, bb/2, bc, bd}, {0, 0, cc/2, cd}, {0, 0, 0, dd/2}};
m = (x + ConjugateTranspose[x]);
mEigensystem = Eigensystem[m, Cubics -> True, Quartics -> True];
evalMX =
With[{mm = mEigensystem[[2]] // N},
Hold[compile[
{{mx, _Complex, 2}},
block[
{
aa = mx[[1, 1]], ...
3
If I don't care very much about the distribution, but just want a symmetric positive-definite matrix (e.g. for software test or demonstration purposes), I do something like this:
m = RandomReal[NormalDistribution[], {4, 4}];
p = m.Transpose[m];
SymmetricMatrixQ[p]
(* True *)
Eigenvalues[p]
(* {9.41105, 4.52997, 0.728631, 0.112682} *)
If I want positive ...
5
As is always the case for the generation of random objects, you need to be careful about the distribution from which you draw them. In the case of random positive semi-definite matrices I would try to draw them from a Haar measure, meaning that they should be drawn from a distribution that is invariant under unitary/orthogonal transformations. This can be ...
4
ClearAll[rpsdm]
rpsdm[n_] := Module[{k},
While[Not[PositiveSemidefiniteMatrixQ[k = RandomReal[{-1, 1}, {n, n}]]]]; k]
Examples:
Row[Panel[MatrixForm @ #,
Row[{"PositiveSemidefiniteMatrixQ:", PositiveSemidefiniteMatrixQ @ #}]] & /@
Table[rpsdm[4], 3], Spacer[10]]
0
That's precisely what a KroneckerProduct is:
KroneckerProduct[{a1, a2, a3}, {1, 1, 1}]
(* {{a1, a1, a1}, {a2, a2, a2}, {a3, a3, a3}} *)
0
You have already answered your question. I only give two other solutions that came first into head:
d = 3;
a = RandomReal[{-3, 3}, {d}];
a /. {x_, y_, z_} -> {{x, x, x}, {y, y, y}, {z, z, z}}
(* {{1.62507, 1.62507, 1.62507}, {2.03748, 2.03748,
2.03748}, {-0.478757, -0.478757, -0.478757}} *)
and
Map[Times[#, {1, 1, 1}] &, ...
1
One fast way to implement this is to make use of SparseArray. Let us first define the dimension of the matrix:
dim=5
We can then then define the command matrix whose $n^\text{th}$ value represents $n^\text{th}$ iteration:
matrix[0] = ConstantArray[0, {dim, dim}];
matrix[n_] := matrix[n] = matrix[n - 1] +
With[{a = RandomInteger[{1, dim}], b = ...
4
Mathematica's function MatrixRank can take a Modulus argument when used with integer matrices. In my experiments (using a matrix m computed using your code) I noted:
It is very much faster than an exact computation.
It gives the correct answer most of the time when using a prime modulus that is not too small.
For example:
{#, MatrixRank[m, Modulus -> #...
5
You might find this interactive version educational.
With[{n = 5},
DynamicModule[{m = ConstantArray[0, {n, n}], nextM},
nextM[] :=
Module[{i, j},
{i, j} = RandomInteger[{1, n}, 2];
m[[i, j]] = m[[j, i]] = RandomInteger[]];
Manipulate[
m // MatrixForm,
Row[{Invisible @ Button["********", {}], Button["Next", nextM[]]...
6
First, define an $ n $-by-$ n $ symmetric matrix of all zeros and ones:
n = 5; a = RandomInteger[{0, 1}, {n, n}];
a = UpperTriangularize[a] + LowerTriangularize[Transpose[a]] -
DiagonalMatrix[Diagonal[a]]
Now define a function that randomly changes two of the elements while maintaining symmetry:
change[x_] := Module[{b = x},
{...
5
The matrix contains an unknown parameter m (typo?). We set m = 0, then the code for finding p,q,r has the form:
m = 0; z[p_, q_, r_,
s_] := {{-1, p, q, r, (1 - p - q - r), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {(1 - p - q - r), -1, p, q, r, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {(1 - s)*r, (1 - s)*(1 - p - q - r), -1, (1 - s)*p, (1 - s)*q,
0, 0, 0, s*...
9
First a CompiledFunction; it expects the T-matrices and the M matrices is separate lists.
cf = Compile[{{T, _Complex, 3}, {M, _Complex, 3}, {B0, _Complex}},
Block[{u, n},
n = Min[Length[T], Length[M]];
u = {1. + 0. I, B0};
Join[
{u},
Table[
u = Compile`GetElement[M, i].(Compile`GetElement[T, i].u),
{i, 1, n}]
]
]...
0
Define ticks2 using t[[r]] and t[[c]] in place of t in your code for ticks.
ticks2 = {{Table[{i, t[[r]][[i]]}, {i, 1, Length@t}], None}, {None,
Table[{i, Rotate[t[[c]][[i]], 90 Degree]}, {i, 1, Length@t}]}};
Row[MapThread[Panel @
MatrixPlot[#, Mesh -> True, ImageSize -> 1 -> 40,
ColorFunction -> ColorData[{"TemperatureMap", "...
2
OK, stealing from my other answer here
There's no need to immediately generate the complex numbers, so hold off.
push[p1_, p2_] := If[p1 != p2, p1 + α (p1 - p2)/((p1 - p2).(p1 - p2))^β, p1];
spread[pts_] := Map[Normalize, (Outer[push[#1, #2] &, pts, pts, 1] // Transpose // Total)];
maxDot[pts_] := Map[Dot[#[[1]], #[[2]]] &, Permutations[pts, {2}]]...
2
I think you can just use it as expected...
SeedRandom[42]; (* Just so the example is reproducible *)
ε=LeviCivitaTensor[3]
b=RandomInteger[100,{3,3}]
c=RandomInteger[100,{3,3}]
a=Table[Sum[ε[[j,m,n]] b[[i,m]] c[[j,n]],{m,1,3},{n,1,3}],{i,1,3},{j,1,3}]
(5418 -5204 -792
279 -1404 372
-1104 -8254 2644 )
1
There are many ways to go about such calculations. Here is one where the parameter sets are encapsulated with Association, the Wolfram Language's equivalent of what are called hash-tables or dictionaries in other programming languages.
sectionParams =
{Association[{λ -> 1, cp -> 2, ρ -> 3}],
Association[{λ -> 4, cp -> 5, ρ -> 6}],
...
2
Solve a simpler problem...
mm2 = {{m11, m12, m13},
{m12, m22, m23},
{m13, m23, m33}};
gg2 = Transpose[aa].mm2.aa;
Solve[gg2 == Conjugate[mm2], Union@Flatten@mm2];
(* {{m11 -> 0, m12 -> 0, m13 -> 0, m22 -> 0, m23 -> 0, m33 -> 0}} *)
So as @Cesareo notes in the comments, all of the parameters are zero.
2
I know this question is a bit old but Wolfram has an official solution on their MathWorld website which I've tested and it works well.
Just use the following function:
HessianH[f_, x_List?VectorQ] := D[f, {x, 2}]
It's used like one would expect:
(* Your function *)
f[x_, y_, z_] := 100*(y - x^2) + (1 - x)^2 + 100 (z - y^2) + (1 - y)^2
(* Just pass ...
1
Using an alternative method suggested in this answer to generate the two matrices:
ClearAll[l, n, k, j]
m2 = Values @ Solve[{Total[{l, n, k, j}^Range[4]] ==
0, -10 <= l <= 0 && -10 <= k <= 0 && 0 <= n <= 10 &&
0 <= j <= 10}, {n, j, k, l}, Integers];
m2 == m
True
new2 = ArrayReshape[...
0
Two things to note are (1) different eigenvector normalization would lead to different M-matrices and (2) when $(x,y)=(1,0)$ we have two eigenvectors for the repeated eigenvalue, so which eigenvector do we call "first"? We let Mathematica choose the normalization and the eigenvector order in the following code:
H = {{x^2, y}, {y^2, x}};
allM = Table[
...
0
Another possibility
ClearAll[x, y];
H = {{x^2, y}, {y^2, x}};
v = First@Eigenvectors[H];
A = v[[1]]; B = v[[2]];
M = {{A, B}, {A*A, B}};
xCoord = {1, 2, 3, 4};
yCoord = {0, 1, 2, 5};
coord = Partition[Riffle[xCoord, yCoord], 2];
data = {{#[[1]], #[[2]]}, Limit[M, {x -> #[[1]], y -> #[[2]]}]} & /@ coord;
data = {#[[1]], MatrixForm[#[[2]]]} & /@ ...
0
There are lots of possible way to do this; which is preferable is likely to depend on your specific needs. One method is to form a Function and then MapThread that across your values. Below Evaluate is used to get the definition of M into the held Function body instead of a verbatim M.
Clear[x, y]
MapThread[{x, y} \[Function] Evaluate[M], {{1, 2, 3, 4}, {...
Top 50 recent answers are included
