8
ClearAll[dropZRC1, dropZRC2, dropZRC3]
dropZRC1 = Module[{p = Flatten@Position[SparseArray[#]["MatrixColumns"], {__}]},
#[[p,p]]] &;
dropZRC2 = Module[{p = Flatten@Position[#, {___, Except[0], ___}]}, #[[p, p]]] &;
dropZRC3 = Module[{p = Position[#, {0 ..}]}, Nest[Transpose[Delete[#, p]] &, #, 2]] &;
For OP's list all three methods ...
7
You can also use Minors to get all square sub-matrices of desired dimensions:
minors = Join @@ Minors[X, 3, Identity];
mr2minors = Select[MatrixRank@# == 2 &]@minors;
Row[MatrixForm /@ mr2minors]
List all 3X3 minors and highlight the ones with rank 2:
Grid @ Partition[MatrixForm /@ minors /.
a : MatrixForm[Alternatives @@ mr2minors] :> ...
7
I believe what you want is
Outer[#2.#1.#2 &, M, V, 1]
First of all, you don't need to Transpose vectors in Mathematica. Dot knows what to do automatically. Second, you need to use the optional extra argument for Outer that tells it the level at which the "object" that you are feeding to the function lives. Otherwise, Outer seeks the lowest level by ...
7
Use the first argument of Graph to provide the vertex list to have the indices of AdjacencyMatrix to match the vertex indices:
g1 = Graph[Range[6], {1 \[DirectedEdge] 4, 6 \[DirectedEdge] 2, 3 \[DirectedEdge] 5}];
am1 = AdjacencyMatrix[g1];
am1 // MatrixForm // TeXForm
$\left(
\begin{array}{cccccc}
0 & 0 & 0 & 1 & 0 & 0 \\
0 & 0 ...
6
I would do it this way: 1) find the position on the elements equal to $1$ on the diagonal, 2) select the corresponding rows and columns.
operate[mat_] := With[{pos = Flatten@Position[Diagonal@mat, 1]}, mat[[pos, pos]]]
operate@{{1, 0}, {1, 0}}
(* {{1}} *)
operate@{{1, 0, 1}, {1, 0, 1}, {0, 0, 1}}
(* {{1, 1}, {0, 1}} *)
operate@{{0, 0, 1, 1}, {1, 1, 0, 1}, {...
6
Follows a classical Genetic Algorithm with the normal functionalities as
Population initialization
Fitness Evaluation
Crossover
Mutation
Offspring Selection
The main difficulty found to implement this procedure was the crossover implementation, because the offspring should preserve always the same elements (1,2,3,4,5,6,7,8,9) without absences or ...
6
First of all, I observed that your matrix can be represented as KroneckerProduct of smaller matrixes which are themselfes KroneckerProduct (or TensorProducts) of vectors:
Ux = Table[m^2 Sin[m x], {m, 1, k}];
Vx = Table[p^2 Sin[p x], {p, 1, k}];
Uy = Table[Sin[n y], {n, 1, k}];
Vy = Table[Sin[q y], {q, 1, k}];
Ax = KroneckerProduct[Ux, Vx];
Ay = ...
6
This is a slightly different approach from what you asked, but still produces the wanted result. I won't use a loop, while I will look for all the possible combination "at the same time" (it's not always convenient to use loops in Mathematica).
X = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {1, 1, 0}, {1, 0, 1}, {0, 1, 1}, {1, 1, 1}};
Generate all possible subsets ...
5
Just remove all the extra {} stuff you have in exponents. i.e. do not write x^{2} but use x^2 etc.. for all the other places.
B = Norm[{x, y, z}]
r = 1 - K*B^2
A = {
{(1 - K (y^2 + z^2))/r, (K*x*y)/r, (K*x*z)/r},
{(K*x*y)/r, (1 - K (x^2 + z^2))/r, (K*y*z)/r},
{(K*x*z)/r, (K*y*z)/r, (1 - K (x^2 + y^2))/r}
};
A // MatrixForm
evecs = Eigenvectors[A]...
5
You have run into a bug in SmithDecomposition, but the example you've posted doesn't trigger it.
First, the bug. It only occurs in very rare corner cases, so much so that if you sit there and feed random matrices to SmithDecomposition you'll never see it fail. This presumably explains how it got through testing. The effect of the bug is that ...
5
Numerically all 100 differences between 100 corresponding elements of matrices correspond fall into just 5 symmetric values:
Round[Union[Flatten[mat1-mat2]],.0001]
{-0.0025,-0.0019,-0.0015,-0.001,0.,0.001,0.0015,0.0019,0.0025}
Which looks a lot like some small noise imposed on:
{-25,-20,-15,-10,0,10,15,20,25}/10000
It is actually quite easy to ...
5
Using the function MaximizeOverPermutations from this great answer by Roman:
ClearAll[f]
f[samp_List] := Det[Partition[samp, 3]]
MaximizeOverPermutations[f, 9, {1/100, 10}, 10^4] // AbsoluteTiming
{0.664876, {{5,7,1,3,6,8,9,2,4}, 412.}}
ResourceFunction["MaximizeOverPermutations"][f, 9]
{{{1, 4, 8, 7, 2, 6, 5, 9, 3}, {1, 5, 7, 8, 3, 6, 4, 9, 2}, {1, ...
5
You can use SatisfiabilityCount for this. First, represent each matrix element in binary so that:
$$b_{i,j}=\sum _{k=0}^d b(i,j,k) 2^k$$
where the largest number is less than $2^{d+1}$.
Then, the constraint that column $j$ is even can be represented as:
evenColumn[j_] := BooleanCountingFunction[{{0, 2, 4}}, Table[b[i, j, 0], {i, 4}]]
or odd:
oddColumn[...
4
Complete update...
OK, a method that solves it directly and is extremely fast for all sizes.
Since we are only concerned with parity relations, the only thing that matters is whether an element of $B_{N}$ is odd or even. Let an odd element be marked by 1 and an even element be marked by 0. Call the matrix $P_{N}$ to denote a parity matrix. There are only $...
4
Consider the operator
$$
\sigma_z=\sum_{i=1}^3\sigma_{i,z},
$$
which is
σ1z + σ2z + σ3z // MatrixForm
This operator commutes with the Hamiltonian:
#.H - H.# &@(σ1z + σ2z + σ3z) // Abs // Total // Total
(* 0 *)
Thus, the Hamiltonian can be block-diagonalized according to different eigen-subspaces of $\sigma_z$. To do this, we pick out the ordering of ...
4
Is this a correct implementation of the principal-leading-minors test for positive-semidefiniteness?
An efficient way to check for positive (semi)definiteness is to try to compute the Cholesky decomposition of a Hermitian matrix. To simplify things, here's a modified version of the routine from this answer, which compute the root-free variant for a Hermitian matrix:
LDLH[mat_?SquareMatrixQ] := Module[{n = Length[mat], mt = mat, v, w},
Do[If[j > 1,
...
3
Just use Table
SeedRandom@12;
m = Table[RandomInteger[5, {2, 2}], 3];
MatrixForm /@ m
m=$\{\left(
\begin{array}{cc}
1 & 1 \\
0 & 0 \\
\end{array}
\right),\left(
\begin{array}{cc}
5 & 4 \\
1 & 4 \\
\end{array}
\right),\left(
\begin{array}{cc}
5 & 3 \\
0 & 5 \\
\end{array}
\right)\}$
v = Table[RandomInteger[5, 2], 3]
v={{3,...
3
ClearAll[sE]
sE = Module[{m0 = Normalize[#, Total] & /@ Transpose[#]}, Total[-Log[m0] m0]] &;
sE[mat] == HH1
True
3
Not a full answer...
I took what proved to be a similar approach as @eyorble, in that I turn it into a graph problem.
I also just demonstrate how to get a lot of solutions, but not the guaranteed total number of solutions. I think the total number blows up combinatorically, so probably not worth counting.
The main idea is that the matrix $A$ is invertible,...
3
Maybe something like:
ClearAll[map2]
map2[matrixA_?MatrixQ, matrixB_?MatrixQ, t1_Real, t2_Real] := Module[{indices =
Union @@ (Partition[#, 2, 1] & /@ FindPath[AdjacencyGraph[
Map[Boole[t1 <= # <= t2] &, matrixA, {-1}]], #, #2, ∞, All])},
HighlightGraph[Graph[DirectedEdge @@@ indices,
EdgeWeight -> Extract[matrixB, ...
3
Maximize works for 2*2 matrix, but gets out of memory for 3*3 on my 16 GB computer.
max4 = Maximize[{Det@Partition[Array[a, 4], 2],
And @@ Thread[0 < Array[a, 4] < 5] &&
Unequal @@ Array[a, 4]},
Array[a, 4], Integers]
(* {10, {a[1] -> 3, a[2] -> 1, a[3] -> 2, a[4] -> 4}} *)
nmax9 = Maximize[{Det@Partition[Array[a, ...
2
Something like this?
Join @@ MapIndexed[Partition[#1, 2] /. x_?VectorQ :> Join[x, 0.01 #2] &, m]
ListPlot3D[%, PlotStyle -> PointSize[0.02]]
{{0, 0, 0.01}, {0, 0, 0.01}, {0, 1, 0.02}, {-1, 0, 0.02}, {0, 1,
0.03}, {0, -1, 0.03}, {0, 2, 0.04}, {-2, -8, 0.04}, {1, 0,
0.05}, {-1, 0, 0.05}, {1, 0, 0.06}, {0, -1, 0.06}, {1, 1,
0.07}, {-...
2
Try
n=4;m=3;
f[mat_]:=Count[Map[Max,mat],1]>m;
allmat=Partition[Tuples[{0,1},n^2],n];
allsubmat=Flatten[Map[Table[#[[1;;n,i;;i+m-1]],{i,1,n-m+1}]&,allmat],1];
Count[Map[f,allsubmat],True]
which instantly returns 28672
f tests whether a matrix has more than m rows containing 1. allmatcontains all possible matricies of 0 and 1. allsubmat contains all ...
1
For a real symmetric matrix X, we can replace the constraint PositiveDefiniteMatrixQ[X] with Thread[Eigenvalues[X] > 0].
To get around the issue caused by Sign in OP's example A we can apply PiecewiseExpand on Det[A] in the objective function:
min = FindMinimum[{PiecewiseExpand[Det[A], Element[d, Reals]],
a^2 + b^2 - 2 c^2 >= 0, Thread[...
1
One simple way to do this, is to just introduce a function that returns a huge number when the constraint is not met:
ClearAll[det2];
det2[mat_?PositiveSemidefiniteMatrixQ] := Det[mat];
det2[_?(MatrixQ[#, NumericQ] &)] := 10^100;
FindMinimum[{det2[M], a >= 1, b >= 1}, {a, b}]
(* {1., {a -> 1., b -> 1.}} *)
This works for this toy example, ...
1
$Version
(* "12.0.0 for Mac OS X x86 (64-bit) (April 7, 2019)" *)
Clear["Global`*"]
Assuming that all of the variables are real
sys1 = {Abs[a1 b1] + Abs[a2 b2] + Abs[a3 b3],
9 (a1^2 + a2^2) <= 4,
18 (a1^2 + a2^2) + 9 (2 + 3 a2) a3^2 <= 8,
4 (b1^2 + b2^2 + b3^2) <= 1} /.
Abs[z_] :> Sqrt[z^2];
var1 = Variables[Level[sys1, {-1}]...
1
A bit messy, but it should work:
process[m_] := Block[{t = m, temp, ind},
temp = Position[Diagonal[t], 0];
ind = temp - Range[0, Length@temp - 1];
((t = Transpose[Drop[Transpose[Drop[t, #]], #]]) & /@ ind)[[-1]]
]
process[{{1, 0}, {1, 0}}]
{{1}}
process[{{1, 0, 0, 0}, {1, 0, 1, 0}, {0, 1, 1, 0}, {1, 0, 0, 0}}]
{{1, 0}, {0, 1}}
1
A "genetic algorithm" of this question:
(*QQ:2636051698*)
maxDet[n_, size_, iterations_] :=
Module[{fitness, choose, mutation, mutationInGroup, result},
fitness =
Compile[{{list, _Real, 1}},
Evaluate@Det@Quiet@Array[list[[n # + #2 - n]] &, {n, n}],
RuntimeAttributes -> Listable];
choose[group_] := group[[Ordering[Abs@...
1
Here is what I could do to answer my own question:
ClearAll[n, matA, matB, map];
<< IGraphM`;
<< BoolEval`;
SeedRandom[4];
n = 10;
matA = RandomReal[{0.1, 0.5}, {n, n}];
matB = RandomReal[{0.1, 0.5}, {n, n}];
map[matrixA_?MatrixQ, matrixB_?MatrixQ, lb_Real, ub_Real] :=
Module[{matA = matrixA, matB = matrixB, t1 = lb, t2 = ub,
...
1
Instead of using Table[] to generate the matrix entry-wise, one can do this by directly manipulating the original matrix.
I'll use a bigger example to illustrate:
mm = Array[C, {5, 5}];
Then,
With[{k = 2},
Drop[mm, {k}, {k}] +
(# - DiagonalMatrix[Diagonal[#]]) &[Delete[mm[[All, k]], k] ~KroneckerProduct~
...
Only top voted, non community-wiki answers of a minimum length are eligible
